Date: Fri, 18 Sep 87 14:37:55 +0200 (Central European Sommer Time) From: XBR4D715%DDATHD21.BITNET@wiscvm.wisc.edu (KLaus D. Schmitt THD Inst. f. EEV FB17) Subject: kermit for Apollo V2.8a PROGRAM KERMIT(INPUT,OUTPUT); (******************************************************************************) (* *) (* KERMIT File Transfer Utility *) (* ============================ *) (* *) (* The following program implements the Kermit file transfer protocol. The *) (* protocol was designed at the Columbia University Center for Computing *) (* Activities (CUCCA) in 1981-1982 by Bill Catchings and Frand da Cruz. *) (* *) (* This particular implementation of Kermit was developed at Control Data *) (* Corporation to run on the Apollo computer systems. It implements the *) (* protocol as outlined in the Kermit Protocol Manual, Fifth Edition. This *) (* implementation of Kermit is designed to run as a "remote" Kermit and *) (* therefore does not implement any of the "local" Kermit commands. This *) (* Kermit is particularly suited for running in 'server' mode. *) (* *) (******************************************************************************) (* *) (* RECORD OF CHANGES *) (* ================= *) (* *) (* VERSION NUMBER DESCRIPTION OF CHANGES *) (* -------------- --------------------------------------------------------- *) (* *) (* Version 1.0 This is the first version of Kermit to run on the Apollo. *) (* This version only operated in server mode, recognizing *) (* the send initiate, receive initiate, and the finish *) (* commands. Completed 5-27-84. *) (* *) (* Version 1.1 This version added several corrections to Version 1.1, *) (* the debug file for a session was placed into the current *) (* directory, added a header to the log-in, and added *) (* timeouts to the program. Completed 6-2-84. *) (* *) (* Version 1.2 This version corrected a few bugs found in Version 1.1. *) (* which occurred when the connected Kermit attempted to *) (* send multiple files to this Kermit. There are some very *) (* minor changes in this version which are included in *) (* preparation for Version 2.0, which will implement the *) (* Kermit Protocol 5th Edition. Completed 6-8-84. *) (* *) (* Version 2.0 This version implemented the Kermit commands and ideas *) (* which are outlined in the Kermit Protocol 5th Edition. *) (* There are still minor commands not implemented in this *) (* version and the local Kermit commands are not yet *) (* implemented. Completed 7-27-84. *) (* *) (* Version 2.1 This version added a local mode to Kermit. This includes *) (* the implementation of a dumb terminal emulator for the *) (* connect command, modification of the send and receive *) (* commands to support local mode, the addition of a get *) (* command, and the addition of a finish command. Completed *) (* 8-6-84. *) (* *) (* Version 2.2 This version added the set noecho command to the local *) (* mode of Kermit. This particular version also cleaned up *) (* some bugs discovered in versions 2.0 and 2.1. Completed *) (* 8-10-84. *) (* *) (* Version 2.3 This version added a display during file transmissions, *) (* if in local mode, to show the number of packets *) (* successfully transmitted and to show the number of *) (* retries. Completed 8-17-84. *) (* *) (* Version 2.4 This version implements a Cyber-722 terminal emulation *) (* when in connect mode. Completed 9-19-84. *) (* *) (* Version 2.5 This version corrected some bugs discovered which were *) (* related to the logging of transactions. Completed *) (* 9-20-84. *) (* *) (* Version 2.6 This version corrected some bugs discovered which were *) (* related to the processing of checksum errors. Completed *) (* 10-18-84. *) (* *) (* Version 2.7 This version will not insert extra eoln characters when *) (* a line is >256 bytes long. Completed 11/14/86. *) (* *) (* Version 2.8 This version implements QBIN partially. 8-bit quoting is *) (* always done in this version; it is not optional. See the *) (* Kermit protocol description where is describes the use of *) (* 'N' and 'Y' in the QBIN field of the initialization *) (* packet. *) (* Completed 1/12/87. *) (* *) (* VERSION 2.8a - beware: don't use -opt AND -cpu 3000 when compiling !! *) (* !!^^^^^^!! this is a BUG in Apollos's PASCAL Compiler !! *) (* - function EXISTF replaced with STREAM_$INQUIRE *) (* - FILE NOT FOUND when SENDing indicated *) (* - SEND (file_type=ascii) now correctly uses CR/LF *) (* - TRANSMIT dto. *) (* - GET procedure: OPEN(rcvfile, ... ), WRITE(rcvfile, ... )*) (* repl. with: OPENO(rcvid, ... ), PUTBUF(rcvid, ... ) *) (* Files will be treated correctly in type (ascii/binary) *) (* N. Schmidt, B. Hochstein, K. Schmitt Completed 18.09.87 *) (* *) (******************************************************************************) %nolist; %include '/sys/ins/base.ins.pas'; %include '/sys/ins/sio.ins.pas'; %include '/sys/ins/pgm.ins.pas'; %include '/sys/ins/pfm.ins.pas' ; %include '/sys/ins/pad.ins.pas'; %include '/sys/ins/streams.ins.pas'; %include '/sys/ins/error.ins.pas'; %include '/sys/ins/cal.ins.pas'; %include '/sys/ins/time.ins.pas'; %include '/sys/ins/vfmt.ins.pas'; %include '/sys/ins/rws.ins.pas'; %include '/sys/ins/ec2.ins.pas'; %include '/sys/ins/smdu.ins.pas'; %include '/sys/ins/name.ins.pas'; %include '/sys/ins/gpr.ins.pas'; %include '/sys/ins/kbd.ins.pas'; %list; CONST (* The following constants are to default streams assigned by the system *) ERRIN = STREAM_$ERRIN; ERROUT = STREAM_$ERROUT; STDIN = STREAM_$STDIN; STDOUT = STREAM_$STDOUT; (* The following constants are ascii codes for usefull characters *) NUL = CHR(0); SOH = CHR(1); BEL = CHR(7); BS = CHR(8); LF = CHR(10); CR = CHR(13); ESC = CHR(27); RS = CHR(30); SP = CHR(32); DEL = CHR(127); (* The following constants are restrictions placed on packets *) MAXPACKETLENGTH = 94; MAXNUMBEROFPACKETS = 64; MAXSEQUENCENUMBER = 63; { max number of packets - 1 } MAXDATALENGTH = 91; DEFAULT_maxtries = 5; DEFAULT_send_delay = 10; DEFAULT_escape_char = CHR(29); { ctrl ] } (* The following constants are used for handling event counters *) NUMBER_OF_ECS = 3; TIME_INDEX = 1; STRIN_INDEX = 2; KEYBD_INDEX = 3; (* The following are miscellaneous constants for readability *) MAX_BUFFER_SIZE = 256; FOREVER = FALSE; VERSION = 'Version 2.8a'; VERSIONLENGTH = 12; TYPE cmdtyps = (NULLCMD, EXITCMD, SENDCMD, RECEIVECMD, LOCALCMD, HELPCMD, BYECMD, SETCMD, SERVERCMD, TAKECMD, DEFINECMD, SHOWCMD, STATISTICSCMD, LOGCMD, TRANSMITCMD, CONNECTCMD, GETCMD, FINISHCMD); kermitstates = (ABORT, SEND_INIT, SEND_FILE, SEND_DATA, SEND_EOF, SEND_BREAK, COMPLETE, REC_INIT, REC_FILE, REC_DATA, START, REC_SERVER_IDLE, SEND_SERVER_INIT, SEND_GEN_CMD); datalengthtyp = 1 .. MAXDATALENGTH; (* +2.8a *) databuffer = PACKED ARRAY[datalengthtyp] OF CHAR; packettyp = (D, Y, N, S, B, F, Z, E, R, G, Timeout, Checksum_error); packetrec = RECORD mark : CHAR; len : 0 .. MAXPACKETLENGTH; seq : 0 .. MAXSEQUENCENUMBER; typ : packettyp; data : databuffer; check : CHAR; END; (* of packet *) packetstrtyp = PACKED ARRAY[1 .. MAXPACKETLENGTH+2] OF CHAR; filetyp = (ascii, binary); filebuffer = RECORD data : databuffer; len : 0 .. MAXPACKETLENGTH; END; (* of file buffer *) buffer_typ = ARRAY[1 .. MAX_BUFFER_SIZE] OF CHAR; stream_io_typ = RECORD buffer : buffer_typ; { buffer for storing I/O } size : INTEGER32; { how much is in the buffer } index : INTEGER; { points to last char processed } ptr : ^buffer_typ; { returned by streams } currchar : CHAR; { character just received } prevchar : CHAR; { previous character received } rcvdchar : BOOLEAN; { flag for character received } timedout : BOOLEAN; { flag for timeout while waiting } END; (* of stream_io_typ *) VAR mode : (host, local); command : cmdtyps; state : kermitstates; server_mode : BOOLEAN; (* boolean flag signifying whether server *) (* mode has been toggled *) take_mode : BOOLEAN; receivedpacket : packetrec; currentpacket : 0 .. MAXSEQUENCENUMBER; packet : ARRAY[0 .. MAXSEQUENCENUMBER] OF packetrec; numberoftries : INTEGER; (* number of times current packet has been *) (* sent or received *) maxtries : INTEGER; (* maximum number of times current packet *) (* can be sent or received *) send_delay : INTEGER; (* the number of seconds to delay before *) (* beginning to send a file, this will *) (* the user to get back to their local *) (* machine to issue a receive command *) escape_char : CHAR; (* the escape character to be used to *) (* delimit commands in connect mode *) local_echo : BOOLEAN; (* boolean flag signifying whether local *) (* keystrokes should be echoed in connect *) (* mode *) debugfile : TEXT; takefile : TEXT; file_type : filetyp; (* specifies whether full 8-bit bytes *) (* should be sent, or just 7 of the 8 bits *) xmtfile : TEXT; xmtid : integer16; { stream id } xmtname : databuffer; xmtlength : datalengthtyp; xmt_eof : BOOLEAN; xmtbuffer : RECORD data : databuffer; len : 0 .. MAXDATALENGTH; END; (* of xmtbuffer *) rcvfile : TEXT; rcvid : integer16; { stream id } (* +2.8a *) rcvname : databuffer; rcvlength : datalengthtyp; rcvbuffer : RECORD data : PACKED ARRAY[1 .. MAX_BUFFER_SIZE] OF CHAR; len : 0 .. MAX_BUFFER_SIZE; END; (* of rcvbuffer *) transactfile : TEXT; (* file for LOGging transactions *) transactname : databuffer; (* name of LOG file *) transactlength : datalengthtyp; (* length of LOG file name *) sessionfile : TEXT; (* file for LOGging sessions *) sessionname : databuffer; (* name of LOG file *) sessionlength : datalengthtyp; (* length of LOG file name *) transmitfile : TEXT; statistics : RECORD filename : databuffer; (* name of file *) (* being sent or *) (* received *) namelength : datalengthtyp; (* length of name *) totalpkts : INTEGER32; (* total number *) (* packets sent *) numretries : INTEGER32; (* total number *) (* of retries *) charssent : INTEGER32; (* total char's *) (* sent *) charsrcvd : INTEGER32; (* total char's *) (* received *) maxcharsinpkt : INTEGER; (* size of larg- *) (* est packet *) starttime : TIME_$CLOCK_T; (* time that the *) (* transfer began *) stoptime : TIME_$CLOCK_T; (* time that the *) (* transfer ended *) ovhdsent : INTEGER32; (* number of over *) (* head char's *) (* sent *) ovhdrcvd : INTEGER32; (* number of over *) (* head char's *) (* received *) collecting : BOOLEAN; (* signifies if *) (* statistics *) (* should be *) (* collected *) completed : BOOLEAN; (* signifies if *) (* the transfer *) (* was successful *) END; (* of status *) (* The following variables are all used for setting parameters which are exchanged in the initial connection. For more information please refer to the KERMIT PROTOCOL MANUAL *) markchar : CHAR; (* character to delimit the beginning of a packet *) mymaxl : 0 .. MAXPACKETLENGTH; (* maximum length of packet to receive *) theirmaxl : 0 .. MAXPACKETLENGTH; (* maximum length of packet to send *) mytimeout : INTEGER; (* how long they should wait for a packet from me *) theirtimeout : INTEGER; (* how long I should wait for a packet from them *) mynpad : INTEGER; (* the number of padding characters I want to precede each incoming packet *) theirnpad : INTEGER; (* the number of padding characters they want to precede each incoming packet *) mypadc : CHAR; (* the control character I need for padding, if any *) theirpadc : CHAR; (* the control character they need for padding, if any *) myeol : CHAR; (* the character I need to terminate any incoming packet, if any *) theireol : CHAR; (* the character they need to terminate any incoming packet, if any *) myqctl : CHAR; (* the printable ASCII character I will use to quote control characters *) theirqctl : CHAR; (* the printable ASCII character they will use to quote control characters *) myqbin : CHAR; {[2.8]} (* the printable ASCII character I will use to quote binary characters *) theirqbin : CHAR; {[2.8]} (* the printable ASCII character they will use to quote binary characters *) chkt : INTEGER; (* CHECK TYPE, the method used for detecting errors : 1 = SINGLE-CHARACTER CHECKSUM 2 = TWO-CHARACTER CHECKSUM 3 = THREE-CHARACTER CRC-CCITT only type 1 is implemented. *) rept : CHAR; (* the prefix character to be used to indicate a repeated character *) capabilities : INTEGER; (* A bit mask, in which each bit position corresponds to a capability of KERMIT, and is set to 1 if that capability is present, or 0 if it is not. The following capability bits are defined : 1 : ABILITY TO TIME OUT 2 : ABILITY TO ACCEPT SERVER CMDS 3 : ABILITY TO ACCEPT "A" PACKETS This is a 6-BIT field with BIT5 representing capability 1, BIT4 representing capability 2, and so forth *) (* DEFAULTS FOR THE ABOVE FIELDS ARE SPECIFICALLY DEFINED IN THE KERMIT PROTOCOL MANUAL. THEY ARE AS FOLLOWS : MAXL: 80 NPAD: 0, NO PADDING PADC: 0 (NUL) EOL : CR (CARRIAGE RETURN) QCTL: THE CHARACTER "#" QBIN: THE CHARACTER '&' CHKT: "1", SIGNLE-CHARACTER CHECKSUM REPT: NO REPEAT COUNT PROCESSING MASK: ALL ZEROS (NO SPECIAL CAPABILITIES) *) sentence : STRING; (* used for input from user. *) sentenceindex : INTEGER; logging : RECORD transactions : BOOLEAN; (* indeicates whether logging *) session : BOOLEAN; (* transactions or session *) END; debug : BOOLEAN; (* indicates whether debug mode is on or off. *) sendservNAKs : BOOLEAN; (* indicates whether periodic NAK's should be *) (* sent when the server is waiting for commands. *) (* The following variables are used for monitoring event counters *) waitptrs : ARRAY[1 .. NUMBER_OF_ECS] OF ec2_$ptr_t; waitvalues : ARRAY[1 .. NUMBER_OF_ECS] OF INTEGER32; (* The following variables are used for maintaining I/O to the connected KERMIT *) sio_line : INTEGER; sio_line_opened : BOOLEAN; sio_stream : STREAM_$ID_T; strin_rec : stream_io_typ; strout_rec : stream_io_typ; keybdin_rec : stream_io_typ; keybdout_rec : stream_io_typ; status : STATUS_$T; str_raw : BOOLEAN; str_no_echo : BOOLEAN; handler_rec : PFM_$CLEANUP_REC; subsys_t : ERROR_$STRING_T; subsys_l : INTEGER; module_t : ERROR_$STRING_T; module_l : INTEGER; code_t : ERROR_$STRING_T; code_l : INTEGER; (* function existf (var pathname : databuffer): boolean;extern; -2.8a *) procedure openi (fn: databuffer; fnlen: integer16; text: boolean; sid: integer16);extern; procedure openo (fn: databuffer; (* +2.8a *) fnlen: integer16; (* +2.8a *) text: boolean; (* +2.8a *) sid: integer16);extern; (* +2.8a *) procedure putbuf (sid: integer16; (* +2.8a *) bufptr: univ_ptr; (* +2.8a *) buflen: integer32);extern; (* +2.8a *) procedure getbuf (sid: integer16; bufptr: univ_ptr; buflen: integer32; var retlen: integer32; var eos: boolean);extern; procedure closef (sid: integer16);extern; (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL EXECUTE ANY CLEAN-UP THAT SHOULD BE DONE *) (* BEFORE LEAVING KERMIT. *) (* *) (******************************************************************************) PROCEDURE restore_system; BEGIN (* restore system *) IF sio_line_opened THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$RAW, str_raw, status); SIO_$CONTROL(sio_stream, SIO_$NO_ECHO, str_no_echo, status); IF (mode = local) AND (sio_line_opened) THEN BEGIN STREAM_$CLOSE(sio_stream, status); END; sio_line_opened := FALSE; END; END; (* of restore system *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL OPEN THE SPECIFIED SERIAL I/O LINE. IF THE *) (* CURRENT mode IS host, THEN THE PROCEDURE WILL MAKE SURE THAT STDIN AND *) (* STDOUT ARE SERIAL I/O LINES. IF THEY ARE NOT, THE PROCEDURE WILL SWITCH *) (* THE MODE TO local. *) (* *) (******************************************************************************) PROCEDURE open_sio_line; VAR status : STATUS_$T; BEGIN (* open serial i/o line *) IF sio_line_opened THEN restore_system; IF mode = local THEN BEGIN CASE sio_line OF 1 : STREAM_$OPEN('/DEV/SIO1', 9, STREAM_$UPDATE, STREAM_$NO_CONC_WRI TE, sio_stream, status); 2 : STREAM_$OPEN('/DEV/SIO6', 9, STREAM_$UPDATE, STREAM_$NO_CONC_WRI TE, sio_stream, status); END; IF status.all = STATUS_$OK THEN sio_line_opened := TRUE ELSE BEGIN sio_line_opened := FALSE; WRITELN('Warning : unable to open stream to line ', sio_line:1); RETURN; END; END ELSE sio_line_opened := TRUE; IF sio_line_opened THEN BEGIN SIO_$INQUIRE(sio_stream, SIO_$RAW, str_raw, status); IF status.all = STATUS_$OK THEN SIO_$INQUIRE(sio_stream, SIO_$NO_ECHO, str_no_echo, status); IF (status.all = SIO_$STREAM_NOT_SIO) AND (mode = host) THEN BEGIN mode := local; sio_line_opened := FALSE; END ELSE IF status.all <> STATUS_$OK THEN BEGIN WRITELN('Warning : unable to open stream to line ', sio_line:1); STREAM_$CLOSE(sio_stream, status); sio_line_opened := FALSE; END; END; END; (* of open serial i/o line *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL CLEAR THE statistics RECORD. *) (* *) (******************************************************************************) PROCEDURE clear_statistics; BEGIN WITH statistics DO BEGIN filename := ' '; namelength := 0; totalpkts := 0; numretries := 0; charssent := 0; charsrcvd := 0; maxcharsinpkt := 0; ovhdsent := 0; ovhdrcvd := 0; CAL_$GET_LOCAL_TIME(starttime); stoptime := starttime; collecting := FALSE; completed := FALSE; END; (* of with *) END; (* of clear statistics *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL INITIALIZE THE VARIABLES *) (* *) (******************************************************************************) PROCEDURE initialize; VAR index : INTEGER; status : STATUS_$T; BEGIN (* initialize *) mymaxl := MAXPACKETLENGTH; mytimeout := 15; mynpad := 0; mypadc := NUL; myqctl := '#'; myqbin := '&'; {[2.8]} myeol := CR; chkt := 1; theirmaxl := 80; theirtimeout := 60; theirnpad := 0; theirpadc := NUL; theireol := CR; theirqctl := '#'; theirqbin := '&'; {[2.8]} maxtries := DEFAULT_maxtries; send_delay := DEFAULT_send_delay; escape_char := DEFAULT_escape_char; markchar := SOH; state := START; server_mode := FALSE; take_mode := FALSE; numberoftries := 0; currentpacket := MAXSEQUENCENUMBER; file_type := ascii; transactname := ' '; transactlength := 0; logging.transactions := FALSE; sessionname := ' '; sessionlength := 0; logging.session := FALSE; debug := FALSE; sendservNAKs := TRUE; local_echo := FALSE; clear_statistics; (* empty the xmt and rcv buffers *) xmtbuffer.data := ' '; xmtbuffer.len := 0; rcvbuffer.data := ' '; rcvbuffer.len := 0; WITH strin_rec DO BEGIN size := 0; index := 0; currchar := NUL; prevchar := NUL; rcvdchar := FALSE; END; (* of with *) WITH strout_rec DO BEGIN size := 0; index := 0; currchar := NUL; prevchar := NUL; rcvdchar := FALSE; END; (* of with *) WITH keybdin_rec DO BEGIN size := 0; index := 0; currchar := NUL; prevchar := NUL; rcvdchar := FALSE; END; (* of with *) WITH keybdout_rec DO BEGIN size := 0; index := 0; currchar := NUL; prevchar := NUL; rcvdchar := FALSE; END; (* of with *) (* Obtain the initial status of the i/o lines so they may be reset on. *) (* Also, determine if Kermit is being run as a host or as a local version. *) (* If run as a host, set sio_stream to STDIN (or STDOUT, they will be the *) (* same. If run as a local Kermit, then first try to set sio_stream to *) (* line 1. If unable to, then try line 2. If still unable to set up a *) (* sio line, warn the user that there is no communication lines open. *) SIO_$INQUIRE(STDIN, SIO_$LINE, sio_line, status); IF status.all = STATUS_$OK THEN { Kermit is being run as a remote host } BEGIN sio_stream := STDIN; mode := host; open_sio_line; END ELSE { assum Kermit is being run locally } BEGIN sio_line := 2; { assume we will be using line 2 } sio_line_opened := FALSE; mode := local; END; END; (* of initialize *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SIMPLY PRINT THE OPENING HEADER FOR KERMIT *) (* *) (******************************************************************************) PROCEDURE printheader; VAR clock : CAL_$TIMEDATE_REC_T; BEGIN (* print header *) WRITE('Kermit-apollo ', version:versionlength, ' '); CAL_$DECODE_LOCAL_TIME(clock); CASE CAL_$WEEKDAY(clock.year, clock.month, clock.day) OF CAL_$SUN : WRITE('Sunday, '); CAL_$MON : WRITE('Monday, '); CAL_$TUE : WRITE('Tuesday, '); CAL_$WED : WRITE('Wednesday, '); CAL_$THU : WRITE('Thursday, '); CAL_$FRI : WRITE('Friday, '); CAL_$SAT : WRITE('Saturday, '); END; (* of case *) CASE clock.month OF 1 : WRITE('January '); 2 : WRITE('February '); 3 : WRITE('March '); 4 : WRITE('April '); 5 : WRITE('May '); 6 : WRITE('June '); 7 : WRITE('July '); 8 : WRITE('August '); 9 : WRITE('September '); 10 : WRITE('October '); 11 : WRITE('November '); 12 : WRITE('December '); END; (* of case *) WRITE(clock.day:1, ', ', clock.year:4, ' '); IF clock.hour > 12 THEN WRITELN((clock.hour - 12):1, ':', clock.minute:1, ' PM') ELSE WRITELN(clock.hour:1, ':', clock.minute:1, ' AM'); END; (* of print header *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL INITIALIZE THE EVENTCOUNT POINTERS TO THE *) (* CURRENT EVENTCOUNTERS. *) (* *) (******************************************************************************) PROCEDURE initialize_eventpointers; BEGIN (* initialize eventpointers *) STREAM_$GET_EC(STDIN, STREAM_$GETREC_EC_KEY, waitptrs[KEYBD_INDEX], status); STREAM_$GET_EC(sio_stream, STREAM_$GETREC_EC_KEY, waitptrs[STRIN_INDEX], stat us); TIME_$GET_EC(TIME_$CLOCKH_KEY, waitptrs[TIME_INDEX], status); END; (* of initialize eventpointers *) (******************************************************************************) (* *) (* THE FOLLOWING FUNCTION TAKES AS INPUT A CHARACTER STRING WHICH CONTAINS A *) (* NON-NEGATIVE INTEGER AND RETURNS THAT INTEGER. IF THE CHARACTER STRING *) (* DOES NOT CONTAIN A NON-NEGATIVE INTEGER, THEN -1 IS RETURNED. *) (* *) (******************************************************************************) FUNCTION convert_to_int(token : STRING) : INTEGER; VAR index : INTEGER; temp : INTEGER; BEGIN (* convert to integer *) temp := 0; index := 0; WHILE index < 80 DO BEGIN index := index + 1; IF NOT (token[index] IN ['0' .. '9']) THEN BEGIN IF (token[index] = SP) AND (index > 1) THEN EXIT ELSE BEGIN temp := -1; EXIT; END; END ELSE temp := (temp * 10) + (ORD(token[index]) - ORD('0')); END; (* of while *) convert_to_int := temp; END; (* of convert to integer *) (******************************************************************************) (* *) (* THIS FUNCTION TRANSFORMS THE INTEGER x, WHICH IS ASSUMED TO LIE IN THE *) (* RANGE 0 TO 94, INTO A PRINTABLE ASCII CHARACTER; 0 BECOMES SP, 1 BECOMES *) (* "!", ETC. *) (* *) (******************************************************************************) FUNCTION makechar(x : INTEGER) : CHAR; BEGIN (* char *) makechar := CHR(x + 32); END; (* of char *) (******************************************************************************) (* *) (* THIS FUNCTION TRANSFORMS THE CHARACTER x, WHICH IS ASSUMED TO BE IN THE *) (* PRINTABLE RANGE (SP THROUTH '~', INTO AN INTEGER IN THE RANGE 0 TO 94. *) (* *) (******************************************************************************) FUNCTION unchar(x : CHAR) : INTEGER; BEGIN (* unchar *) unchar := ORD(x) - 32; END; (* of unchar *) (******************************************************************************) (* *) (* THIS FUNCTION MAPS BETWEEN CONTROL CHARACTERS AND THEIR PRINTABLE *) (* REPRESENTATIONS. *) (* *) (******************************************************************************) FUNCTION ctl(x : CHAR) : CHAR; BEGIN (* ctl *) { IF (x < SP) OR (x = DEL) {[2.8]+ old way commented out} { THEN { ctl := CHR((ORD(x) + 64) MOD 128) { ELSE { ctl := CHR((ORD(x) - 64) MOD 128); {} IF (x < CHR (64)) THEN ctl := CHR((ORD(x) + 64)) ELSE ctl := CHR((ORD(x) - 64)); {[2.8]-} END; (* of ctl *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL RETURN A CHECKSUM CHARACTER FOR THE STRING *) (* packetstring, THE CHECKSUM COMPUTATION BEGINS AT THE first CHARACTER *) (* AND ENDS AT THE last CHARACTER. *) (* *) (******************************************************************************) FUNCTION checksum(packetstring : packetstrtyp; first : INTEGER; last : INTEGER) : CHAR; VAR s : INTEGER; index : INTEGER; BEGIN (* checksum *) s := 0; FOR index := first TO last DO s := s + ORD(packetstring[index]); checksum := makechar((s + ((s & 8#300) DIV 8#100)) & 8#77); END; (* of checksum *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL RETURN THE NEXT CHARACTER RECEIVED FROM THE *) (* CONNECTED KERMIT. *) (* *) (******************************************************************************) PROCEDURE getchar(VAR ch : CHAR); VAR key : STREAM_$SK_T; status : STATUS_$T; wakeup : INTEGER; BEGIN (* getchar *) strin_rec.rcvdchar := false; strin_rec.timedout := false; IF strin_rec.index >= strin_rec.size THEN (* we have read everything in this buffer and need a new one *) BEGIN REPEAT waitvalues[STRIN_INDEX] := EC2_$READ(waitptrs[STRIN_INDEX]^); waitvalues[TIME_INDEX] := EC2_$READ(waitptrs[TIME_INDEX]^); STREAM_$GET_CONDITIONAL(sio_stream, ADDR(strin_rec.buffer), MAX_BUFFER_SIZE, strin_rec.ptr, strin_rec.size, key, status); IF status.all <> 0 THEN BEGIN IF (status.subsys = stream_$subs) AND THEN (status.code = stream_$end_of_file) THEN RETURN ELSE BEGIN WRITELN('ERROR READING FROM INPUT STREAM '); RETURN; END; END; (* of status.all *) strin_rec.index := 0; IF strin_rec.size = 0 THEN BEGIN waitvalues[STRIN_INDEX] := waitvalues[STRIN_INDEX] + 1; waitvalues[TIME_INDEX] := waitvalues[TIME_INDEX] + 4 * theirtimeout; { ticks 1/4 sec } wakeup := EC2_$WAIT(waitptrs[TIME_INDEX], waitvalues[TIME_INDEX], 2, status); IF wakeup = TIME_INDEX THEN BEGIN strin_rec.timedout := TRUE; END ELSE BEGIN getchar(ch); RETURN; END; END; IF strin_rec.size < 0 THEN (* stream has more to send, buffer overflow *) BEGIN strin_rec.size := MAX_BUFFER_SIZE; END; UNTIL (strin_rec.size <> 0) OR strin_rec.timedout; END; (* of read another buffer *) IF NOT strin_rec.timedout THEN BEGIN strin_rec.index := strin_rec.index + 1; strin_rec.prevchar := strin_rec.currchar; strin_rec.currchar := strin_rec.ptr^[strin_rec.index]; strin_rec.rcvdchar := true; ch := strin_rec.currchar; END; RETURN; END; (* of getio *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND THE PACKET POINTED TO BY thispacket out *) (* THE DOOR. *) (* *) (******************************************************************************) PROCEDURE sendpacket(thispacket : INTEGER); VAR packetstring : packetstrtyp; index : INTEGER; key : STREAM_$SK_T; status : STATUS_$T; size : INTEGER32; BEGIN (* send packet*) WITH packet[thispacket] DO BEGIN packetstring[1] := mark; packetstring[2] := makechar(len); packetstring[3] := makechar(seq); CASE typ OF D : packetstring[4] := 'D'; Y : packetstring[4] := 'Y'; N : packetstring[4] := 'N'; S : packetstring[4] := 'S'; B : packetstring[4] := 'B'; F : packetstring[4] := 'F'; G : packetstring[4] := 'G'; Z : packetstring[4] := 'Z'; E : packetstring[4] := 'E'; R : packetstring[4] := 'R'; END; (* of case *) IF len > 3 THEN FOR index := 1 TO len-3 DO BEGIN packetstring[4 + index] := data[index]; IF file_type = ascii THEN {mask off the 8th bit of each char} packetstring[4 + index] := CHR(ORD(packetstring[4 + index]) MOD 128); END; packetstring[len+2] := checksum(packetstring, 2, len+1); IF theirnpad > 0 THEN BEGIN size := 1; FOR index := 1 TO theirnpad DO STREAM_$PUT_CHR(sio_stream, ADDR(theirpadc), size, key, status); END; size := len+2; STREAM_$PUT_CHR(sio_stream, ADDR(packetstring), size, key, status); size := 1; STREAM_$PUT_REC(sio_stream, ADDR(theireol), size, key, status); IF debug THEN WRITELN(debugfile, 'THIS WAS SENT : ', packetstring:len+2); IF statistics.collecting THEN BEGIN WITH statistics DO BEGIN charssent := charssent + len + 3 + theirnpad; IF (len + 2) > maxcharsinpkt THEN maxcharsinpkt := len + 2; IF typ = D THEN ovhdsent := ovhdsent + theirnpad + 6 ELSE ovhdsent := ovhdsent + theirnpad + len + 3; END; (* of with *) IF mode = local THEN BEGIN WRITELN(ESC, '[4;11H', statistics.totalpkts:1, ESC, '[0K'); WRITELN(ESC, '[5;11H', statistics.numretries:1, ESC, '[0K'); END; (* of then *) END; (* of then *) END; (* of with *) END; (* of send packet *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WAITS TO RECEIVE THE NEXT PACKET. IF THE PACKET *) (* IS RECEIVED, IT IS BROKEN INTO THE VARIOUS packetrec FIELDS. IF A *) (* TIMEOUT OCCURS, A TIMEOUT PACKET IS RETURNED. THE PACKET IS RETURNED IN *) (* THE GLOBAL receivedpacket. *) (* *) (******************************************************************************) PROCEDURE receivepacket; VAR packetstring : packetstrtyp; index : INTEGER; packetreceived : BOOLEAN; SOHreceived : BOOLEAN; ch : CHAR; packetlength : INTEGER; BEGIN (* receive packet *) packetreceived := FALSE; SOHreceived := FALSE; index := 0; REPEAT getchar(ch); IF strin_rec.timedout THEN BEGIN WITH receivedpacket DO BEGIN mark := MARKCHAR; len := 0; seq := 0; typ := Timeout; data := ' '; check := makechar(0); END; (* of with *) RETURN; END; (* of if timedout *) IF ch = MARKCHAR THEN BEGIN SOHreceived := TRUE; index := 1; packetstring[index] := ch; END ELSE BEGIN IF SOHreceived THEN BEGIN index := index + 1; packetstring[index] := ch; IF index = 2 THEN packetlength := unchar(ch) ELSE BEGIN IF index = packetlength + 2 THEN packetreceived := TRUE; END; END; END; IF statistics.collecting THEN statistics.charsrcvd := statistics.charsrcvd + 1; UNTIL packetreceived; WITH receivedpacket DO BEGIN mark := packetstring[1]; len := unchar(packetstring[2]); seq := unchar(packetstring[3]); CASE packetstring[4] OF 'D' : typ := D; 'Y' : typ := Y; 'N' : typ := N; 'S' : typ := S; 'B' : typ := B; 'F' : typ := F; 'Z' : typ := Z; 'R' : typ := R; 'G' : typ := G; OTHERWISE typ := E; END; (* of case *) data := ' '; IF len > 3 THEN FOR index := 5 TO len+1 DO data[index-4] := packetstring[index]; IF debug THEN WRITELN(debugfile, 'THIS WAS RECEIVED : ', packetstring:len+2); check := checksum(packetstring, 2, len+1); IF check <> packetstring[len+2] THEN BEGIN IF debug THEN WRITELN(debugfile, 'CHECKSUM ERROR'); typ := Checksum_error; END; IF (file_type = ascii) AND (len > 3) THEN {mask off the 8th bit of chr's} FOR index := 1 to len-3 DO data[index] := CHR(ORD(data[index]) MOD 128); IF statistics.collecting THEN BEGIN WITH statistics DO BEGIN IF (len + 2) > maxcharsinpkt THEN maxcharsinpkt := len + 2; IF typ = D THEN ovhdrcvd := ovhdrcvd + theirnpad + 6 ELSE ovhdrcvd := ovhdrcvd + theirnpad + len + 3; END; (* of with *) IF mode = local THEN BEGIN WRITELN(ESC, '[4;11H', statistics.totalpkts:1, ESC, '[0K'); WRITELN(ESC, '[5;11H', statistics.numretries:1, ESC, '[0K'); END; (* of then *) END; (* of then *) END; (* of with *) END; (* of receive packet *) (******************************************************************************) (* *) (* THE FOLLOWING FUNCTION RETURNS A BOOLEAN VALUE SIGNALLING THE RECEPTION *) (* OF AN ACK PACKET. THE FUNCTION WILL ONLY RETURN TRUE IF THE NEXT PACKET *) (* RECEIVED IS A GOOD ACK. IF THE NEXT PACKET IS NOT AN ACK, IS A NAK, OR *) (* NOTHING IS RECEIVED WITHIN THE TIMEOUT PERIOD, THEN THE FUNCTION RETURNS *) (* FALSE. *) (* *) (* NOTE : RECEIVING A NAK FOR THE NEXT PACKET IS THE SAME AS RECEIVING AN ACK *) (* FOR THE CURRENT PACKET. *) (* *) (******************************************************************************) FUNCTION receivedACK : BOOLEAN; BEGIN (* received ACK *) receivedACK := FALSE; { assume that we are not successful } receivepacket; IF ((receivedpacket.typ = Y) AND (receivedpacket.seq = currentpacket)) OR ((receivedpacket.typ = N) AND (receivedpacket.seq = currentpacket+1)) THEN receivedACK := TRUE; END; (* of receivedACK *) (******************************************************************************) (* *) (* THE FOLLOWING FUNCTION RETURNS AN ACK FOR THE MOST RECENTLY RECEIVED *) (* PACKET, IE. THE PACKET IN receivedpacket. *) (* *) (******************************************************************************) PROCEDURE sendACK; VAR thispacket : INTEGER; BEGIN (* send ACK *) thispacket := receivedpacket.seq; WITH packet[thispacket] DO BEGIN mark := markchar; typ := Y; len := 3; data := ' '; seq := thispacket; END; (* of with *) sendpacket(thispacket); END; (* of send ACK *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE RETURNS A NAK FOR currentpacket. *) (* *) (******************************************************************************) PROCEDURE sendNAK; BEGIN (* send NAK *) WITH packet[currentpacket] DO BEGIN mark := markchar; typ := N; len := 3; data := ' '; seq := currentpacket; END; (* of with *) sendpacket(currentpacket); END; (* of send NAK *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND AN ERROR PACKET TO THE CONNECTED KERMIT *) (* WITH THE CORRESPONDING ERROR MESSAGE. *) (* *) (******************************************************************************) PROCEDURE senderror(message : databuffer; messlen : INTEGER); BEGIN (* send error *) WITH packet[currentpacket] DO BEGIN mark := markchar; len := messlen + 3; seq := currentpacket; typ := E; data := message; END; (* of with *) sendpacket(currentpacket); END; (* of send error *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL FILL THE xmtfile's buffer WITH INPUT FROM THE *) (* FILE. *) (* *) (******************************************************************************) PROCEDURE fillxmtbuffer; VAR index : INTEGER; ch : CHAR; retlen : INTEGER32; BEGIN (* fill xmt buffer *) FOR index := 1 TO MAXDATALENGTH DO xmtbuffer.data[index] := SP; xmtbuffer.len := 0; IF NOT xmt_eof THEN REPEAT getbuf (xmtid, ADDR (ch), 1, retlen, xmt_eof); IF retlen = 0 THEN BEGIN IF (xmtbuffer.len > 0) AND (file_type = ascii) THEN BEGIN (* WITH xmtbuffer DO -2.8a *) (* BEGIN -2.8a *) (* data[len+1] := theirqctl; -2.8a *) (* data[len+2] := ctl(CR); -2.8a *) (* data[len+3] := theirqctl; -2.8a *) (* data[len+4] := ctl(LF); -2.8a *) (* len := len + 4; -2.8a *) (* END; -2.8a *) END; (* of then *) END ELSE BEGIN (* IF ORD (ch) & 16#80 <> 0 -2.8a *) {[2.8]+} IF (ORD(ch) > 127) (* +2.8a *) THEN WITH xmtbuffer DO BEGIN data [len+1] := theirqbin; len := len + 1; (* ch := CHR (ORD (ch) MOD 128); -2.8a *) ch := CHR (ORD (ch) - 128); (* +2.8a *) END; {[2.8]-} IF (ch < SP) OR (ch = DEL) OR (ch = theirqctl) OR (ch = theirqbin) {[2.8]} THEN BEGIN WITH xmtbuffer DO BEGIN IF (ch = LF) AND (file_type = ascii) AND (* +2.8a *) (data[len] <> theirqbin) (* +2.8a *) THEN (* +2.8a *) BEGIN (* +2.8a *) data[len+1] := theirqctl; (* +2.8a *) data[len+2] := ctl(CR); (* +2.8a *) len := len + 2; (* +2.8a *) END; (* +2.8a *) data[len+1] := theirqctl; IF (ch = theirqctl) OR (ch = theirqbin) {[2.8]} THEN data[len+2] := ch {[2.8]} ELSE data[len+2] := ctl(ch); len := len + 2; END; (* of with *) END (* of then *) ELSE BEGIN WITH xmtbuffer DO BEGIN data[len+1] := ch; len := len + 1; END; (* of with *) END; (* of else *) END; (* of else *) UNTIL xmt_eof OR (xmtbuffer.len >= theirmaxl-9); END; (* of fill xmt buffer *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL FILL THE rcvfile's buffer WITH THE DATA *) (* IN receivedpacket. IF THE buffer BECOMES FULL OR A CR-LF SEQUENCE IS *) (* ENCOUNTERED, THE THE BUFFER IS WRITTEN TO rcvfile. *) (* *) (******************************************************************************) PROCEDURE fillrcvbuffer; VAR index : INTEGER; bit8 : BOOLEAN; {[2.8]} BEGIN (* fill rcv buffer *) index := 0; WHILE index < receivedpacket.len-3 DO BEGIN index := index + 1; bit8 := FALSE; {[2.8]+} IF receivedpacket.data[index] = myqbin THEN BEGIN index := index + 1; bit8 := TRUE; END; {[2.8-]} IF receivedpacket.data[index] = myqctl THEN BEGIN index := index + 1; IF receivedpacket.data[index] = ctl(LF) THEN BEGIN IF (file_type = ascii) AND (NOT bit8) {[2.8]} THEN BEGIN IF rcvbuffer.data[rcvbuffer.len] = CR THEN BEGIN (* IF rcvbuffer.len = 0 -2.8a *) (* THEN -2.8a *) (* WRITELN(rcvfile) -2.8a *) (* ELSE -2.8a *) (* WRITELN(rcvfile, -2.8a *) (* rcvbuffer.data:rcvbuffe r.len-1); -2.8a *) rcvbuffer.data[rcvbuffer.len] := LF ; (* +2.8a *) putbuf (rcvid, ADDR(rcvbuffer.data) , rcvbuffer.len); (* +2.8a *) rcvbuffer.len := 0; END ELSE BEGIN rcvbuffer.len := rcvbuffer.len + 1; rcvbuffer.data[rcvbuffer.len] := LF ; END; END ELSE {file type is binary} BEGIN rcvbuffer.len := rcvbuffer.len + 1; rcvbuffer.data[rcvbuffer.len] := LF; END; END ELSE BEGIN rcvbuffer.len := rcvbuffer.len + 1; IF receivedpacket.data[index] = myqctl THEN rcvbuffer.data[rcvbuffer.len] := myqctl ELSE {[ 2.8]+} IF receivedpacket.data[index] = myqbin THEN rcvbuffer.data[rcvbuffer.len] := myqbin {[ 2.8]-} ELSE rcvbuffer.data[rcvbuffer.len] := ctl(receivedpacket.data[index]); END; END ELSE BEGIN rcvbuffer.len := rcvbuffer.len + 1; rcvbuffer.data[rcvbuffer.len] := receivedpacket.data[index] ; END; IF bit8 {[2.8] +} THEN WITH rcvbuffer DO data[len] := CHR (ORD (data[len]) + 128); {[2.8 ]-} IF rcvbuffer.len = MAX_BUFFER_SIZE THEN BEGIN (* WRITE(rcvfile, rcvbuffer.data:rcvbuffer.len); - 2.8a *) putbuf (rcvid, ADDR(rcvbuffer.data), rcvbuffer.len); (* + 2.8a *) rcvbuffer.len := 0; END; END; (* of while *) END; (* of fill rcv buffer *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL PROCESS THE PARAMETERS CONTAINED IN THE data *) (* FIELD OF receivedpacket, WHICH SHOULD BE AN S PACKET OR AN ACK FOR AN S *) (* PACKET. *) (* *) (******************************************************************************) PROCEDURE processparams; BEGIN (* process parameters *) WITH receivedpacket DO BEGIN theirmaxl := unchar(data[1]); theirtimeout := unchar(data[2]); theirnpad := unchar(data[3]); theirpadc := ctl(data[4]); theireol := CR; (* CR is the default *) IF len >= 8 THEN IF data[5] <> SP THEN theireol := CHR(unchar(data[5])); theirqctl := '#'; (* # is the default *) IF len >= 9 THEN IF data[6] <> SP THEN theirqctl := data[6]; theirqbin := '&'; (* & is the default *) {[2.8]+} IF len >= 10 THEN IF data[7] <> SP THEN theirqbin := data[7]; {[2.8]-} end; (* of with *) END; (* of process parameters *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL LOG THE MOST RECENT TRANSACTION INTO THE LOG *) (* FILE. *) (* *) (******************************************************************************) PROCEDURE log_transaction; VAR clock : CAL_$TIMEDATE_REC_T; total_time : TIME_$CLOCK_T; total_seconds : INTEGER32; BEGIN (* log transaction *) IF debug THEN WRITELN(debugfile, 'Entering log_transaction'); IF logging.transactions THEN BEGIN WITH statistics DO BEGIN WRITELN(transactfile); WRITELN(transactfile, 'Statistics on most recent file ', 'transferred :'); WRITELN(transactfile); CAL_$DECODE_TIME(starttime, clock); WRITELN(transactfile, ' Starting Time : ', clock.hour:1, ':', clock.minute:1); CAL_$DECODE_TIME(stoptime, clock); WRITELN(transactfile, ' Ending Time : ', clock.hour:1, ':', clock.minute:1); total_time := stoptime; IF CAL_$SUB_CLOCK(total_time, starttime) THEN BEGIN total_seconds := CAL_$CLOCK_TO_SEC(total_time); WRITELN(transactfile, ' Total time : ', total_seconds:1, ' seconds'); END; WRITELN(transactfile, ' Total characters transmitted : ', (charssent + charsrcvd):1); WRITELN(transactfile, ' Characters sent : ', charssent:1); WRITELN(transactfile, ' Characters received : ', charsrcvd:1); WRITELN(transactfile, ' Maximum in one packet : ', maxcharsinpkt:1); WRITELN(transactfile, ' Overhead characters sent : ', ovhdsent:1); WRITELN(transactfile, ' Overhead characters received : ', ovhdrcvd:1); IF charssent + charsrcvd = 0 THEN WRITELN(transactfile, '0.00%') ELSE WRITELN(transactfile, (((ovhdsent+ovhdrcvd) / (charssent+charsrcvd))*100):6:2, '%'); WRITE(transactfile, ' Baud-rate : '); IF total_seconds = 0 THEN WRITELN(transactfile, 'Not determined') ELSE WRITELN(transactfile, ((charssent+charsrcvd) DIV total_seconds)*10:1); WRITE(transactfile, ' Effective baud-rate : '); IF total_seconds = 0 THEN WRITELN(transactfile, 'Not determined') ELSE WRITELN(transactfile, ((charssent+charsrcvd- ovhdsent-ovhdrcvd) DIV total_seconds)*10:1); WRITELN(transactfile); END; (* of with *) END; END; (* of log transaction *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL FILL data WITH THE INITIAL CONNECTION DATA *) (* AS OUTLINED IN THE KERMIT PROTOCOL MANUAL. THE FUNCTION RETURNS THE *) (* LENTH OF THE DATA. *) (* *) (******************************************************************************) FUNCTION createsendinitdata(VAR data : databuffer) : INTEGER; VAR index : INTEGER; BEGIN (* create send-init data *) data[1] := makechar(mymaxl); data[2] := makechar(mytimeout); data[3] := makechar(mynpad); data[4] := ctl(mypadc); data[5] := makechar(ORD(myeol)); data[6] := myqctl; data[7] := myqbin; {[2.8]} FOR index := 8 TO MAXDATALENGTH DO {[2.8]} data[index] := SP; createsendinitdata := 7; {[2.8]} END; (* of create send-init data *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND THE SPECIFIED FILE(S) TO THE CONNECTED *) (* KERMIT. *) (* *) (******************************************************************************) PROCEDURE send_the_files; VAR status : STATUS_$T; (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND A SEND-INIT PACKET *) (* *) (***************************************************************************) PROCEDURE send_sendinit; VAR status : INTEGER32; BEGIN (* send send-init packet *) currentpacket := 0; numberoftries := 0; WITH packet[currentpacket] DO BEGIN mark := markchar; typ := S; len := createsendinitdata(data) + 3; seq := currentpacket; END; (* of with *) REPEAT sendpacket(currentpacket); receivepacket; IF (receivedpacket.typ = Y) AND (receivedpacket.seq = 0) THEN BEGIN processparams; currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS; numberoftries := 0; (* IF NOT existf(xmtname) -2.8a *) (* THEN -2.8a *) (* BEGIN -2.8a *) (* senderror('File not found', 14); -2.8a *) (* state := ABORT; -2.8a *) (* END -2.8a *) (* ELSE -2.8a *) BEGIN openi(xmtname, xmtlength, FALSE, xmtid); xmt_eof := FALSE; statistics.totalpkts := statistics.totalpkts + 1; state := SEND_FILE; END; (* of if *) END (* of then *) ELSE BEGIN numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); state := ABORT; END; END; (* of else *) UNTIL state <> SEND_INIT; END; (* of send send-init packet *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND A FILE-HEADER PACKET. *) (* *) (***************************************************************************) PROCEDURE send_fileheader; VAR temp_time : TIME_$CLOCK_T; temp_num_pkts : INTEGER32; temp_num_retries : INTEGER32; BEGIN (* send file header *) WITH packet[currentpacket] DO BEGIN mark := MARKCHAR; typ := F; len := xmtlength + 3; data := xmtname; seq := currentpacket; END; (* of with *) REPEAT sendpacket(currentpacket); IF receivedACK THEN BEGIN fillxmtbuffer; currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS; numberoftries := 0; IF xmtbuffer.len = 0 THEN (* file is empty *) state := SEND_EOF ELSE state := SEND_DATA; temp_num_pkts := statistics.totalpkts; temp_num_retries := statistics.numretries; temp_time := statistics.stoptime; {starting time is time that} clear_statistics; {the last transfer stopped } statistics.totalpkts := temp_num_pkts + 1; statistics.numretries := temp_num_retries; statistics.starttime := temp_time; statistics.filename := xmtname; statistics.namelength := xmtlength; END ELSE IF ((receivedpacket.typ = N) OR (receivedpacket.typ = Timeout) OR (receivedpacket.typ = Checksum_error)) THEN BEGIN numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); closef(xmtid); state := ABORT; END; END ELSE BEGIN closef(xmtid); state := ABORT; END; UNTIL state <> SEND_FILE; END; (* of send file header *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND THE CURRENT xmtbuffer TO THE USER. *) (* *) (***************************************************************************) PROCEDURE send_filedata; BEGIN (* send file data *) REPEAT IF numberoftries = 0 THEN (* we need to create a packet with the contents of xmtbuffer *) WITH packet[currentpacket] DO BEGIN mark := MARKCHAR; typ := D; len := xmtbuffer.len + 3; data := xmtbuffer.data; seq := currentpacket; END; (* of with *) sendpacket(currentpacket); IF receivedACK THEN BEGIN currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS; statistics.totalpkts := statistics.totalpkts + 1; numberoftries := 0; fillxmtbuffer; IF xmtbuffer.len = 0 THEN BEGIN state := SEND_EOF; END; END ELSE BEGIN CASE receivedpacket.typ OF N, Timeout, Checksum_error : BEGIN numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); closef(xmtid); state := ABORT; END; END; Y : BEGIN IF receivedpacket.seq = (currentpacket-1) MOD MAXNUMBEROFPACKETS THEN BEGIN numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); closef(xmtid); state := ABORT; END; END ELSE BEGIN closef(xmtid); state := ABORT; END; END; OTHERWISE BEGIN closef(xmtid); state := ABORT; END; END; (* of case *) END; UNTIL state <> SEND_DATA; END; (* of send file data *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND AN EOF PACKET TO THE OTHER KERMIT. *) (* *) (***************************************************************************) PROCEDURE send_end_of_file; BEGIN (* send eof *) closef(xmtid); WITH packet[currentpacket] DO BEGIN mark := markchar; typ := Z; len := 3; data := ' '; seq := currentpacket; END; (* of with *) REPEAT sendpacket(currentpacket); IF receivedACK THEN BEGIN currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS; numberoftries := 0; CAL_$GET_LOCAL_TIME(statistics.stoptime); statistics.completed := TRUE; IF logging.transactions THEN log_transaction; statistics.totalpkts := statistics.totalpkts + 1; state := SEND_BREAK; END ELSE IF (receivedpacket.typ = N) OR (receivedpacket.typ = Timeout) OR (receivedpacket.typ = Checksum_error) THEN BEGIN numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); state := ABORT; END; END ELSE state := ABORT; UNTIL state <> SEND_EOF; END; (* of send eof *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND A BREAK PACKET TO THE OTHER KERMIT. *) (* *) (***************************************************************************) PROCEDURE send_a_break; BEGIN (* send break *) WITH packet[currentpacket] DO BEGIN mark := MARKCHAR; typ := B; len := 3; data := ' '; seq := currentpacket; END; (* of with *) REPEAT sendpacket(currentpacket); receivepacket; IF ((receivedpacket.typ = Y) AND (receivedpacket.seq = currentpacket)) OR ((receivedpacket.typ = N) AND (receivedpacket.seq = 0)) THEN BEGIN statistics.totalpkts := statistics.totalpkts + 1; state := COMPLETE END ELSE IF ((receivedpacket.typ = N) AND (receivedpacket.seq = currentpacket)) OR (receivedpacket.typ = Timeout) OR (receivedpacket.typ = Checksum_error) THEN state := SEND_BREAK ELSE state := ABORT; UNTIL state <> SEND_BREAK; END; (* of send break *) BEGIN (* send the files *) statistics.totalpkts := 0; statistics.numretries := 0; IF mode = local THEN BEGIN PAD_$CREATE_FRAME(ERROUT, 80, 25, status); WRITELN(ESC, '[1;1H'); printheader; WRITELN; WRITELN('Packets : ', statistics.totalpkts:1); WRITELN('Retries : ', statistics.numretries:1); END; REPEAT IF debug THEN WRITELN(debugfile, 'STATE : ', ORD(state)); statistics.collecting := TRUE; CASE state OF SEND_INIT : BEGIN send_sendinit; END; SEND_FILE : BEGIN send_fileheader; END; SEND_DATA : BEGIN send_filedata; END; SEND_EOF : BEGIN send_end_of_file; END; SEND_BREAK : BEGIN send_a_break; END; OTHERWISE BEGIN statistics.collecting := FALSE; EXIT; END; END; (* of case *) UNTIL FOREVER; IF mode = local THEN PAD_$DELETE_FRAME(ERROUT, status); END; (* of send the files *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL RECEIVE FILES FROM THE CONNECTED KERMIT. *) (* *) (******************************************************************************) PROCEDURE receive_some_files; VAR status : STATUS_$T; (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL WAIT FOR A SEND-INIT PACKET FROM THE *) (* CONNECTED KERMIT. THIS IS THE ENTRY POINT FOR NON-SERVER RECEIVE *) (* COMMAND. *) (* *) (***************************************************************************) PROCEDURE wait_for_send_init; BEGIN (* wait for send-init *) currentpacket := 0; numberoftries := 0; REPEAT receivepacket; IF (receivedpacket.typ = S) AND (receivedpacket.seq = 0) THEN BEGIN processparams; WITH packet[currentpacket] DO BEGIN mark := markchar; typ := Y; len := createsendinitdata(data) + 3; seq := currentpacket; END; (* of with *) sendpacket(currentpacket); currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS; numberoftries := 0; statistics.totalpkts := statistics.totalpkts + 1; state := REC_FILE; END ELSE IF (receivedpacket.typ = Timeout) OR (receivedpacket.typ = Checksum_error) THEN BEGIN sendNAK; numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); state := ABORT; END; END ELSE BEGIN sendNAK; state := ABORT; END; UNTIL state <> REC_INIT; END; (* of wait for send-init*) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL WAIT FOR A FILE-HEADER PACKET FROM THE *) (* CONNECTED KERMIT. THIS IS THE ENTRY POINT FOR SERVER RECEIVE COMMAND. *) (* *) (***************************************************************************) PROCEDURE wait_for_fileheader; VAR index : INTEGER; temp_time : TIME_$CLOCK_T; temp_num_pkts : INTEGER32; temp_num_retries : INTEGER32; BEGIN (* wait for file-header *) REPEAT receivepacket; CASE receivedpacket.typ OF Timeout, { The advanced state table in the 5.0 Protocol Manual } { suggests sending a NAK, however, I feel that resending } { the previous ACK is more appropriate. } Checksum_error, S : BEGIN (* previous ACK was lost, so re-send it *) IF receivedpacket.seq = currentpacket - 1 THEN BEGIN sendpacket(currentpacket-1); numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); state := ABORT; END; END ELSE BEGIN sendNAK; state := ABORT; END; END; (* of S case *) Z : BEGIN (* previous ACK was lost, so re-send it *) IF receivedpacket.seq = currentpacket - 1 THEN BEGIN sendACK; numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); state := ABORT; END; END ELSE BEGIN sendNAK; state := ABORT; END; END; (* of Z case *) B : BEGIN IF receivedpacket.seq = currentpacket THEN BEGIN sendACK; statistics.totalpkts := statistics.totalpkts + 1; state := COMPLETE; END ELSE BEGIN sendNAK; state := ABORT; END; END; (* of B case *) F : BEGIN rcvname := receivedpacket.data; rcvlength := receivedpacket.len - 3; IF rcvname[rcvlength] = '.' THEN BEGIN rcvname[rcvlength] := SP; rcvlength := rcvlength + 1; END; IF rcvlength < MAXDATALENGTH THEN FOR index := rcvlength+1 TO MAXDATALENGTH DO rcvname[index] := SP; (* OPEN(rcvfile, rcvname, 'UNKNOWN'); -2.8a *) (* REWRITE(rcvfile); -2.8a *) IF (file_type = ascii) THEN (* +2.8a *) openo(rcvname, rcvlength, TRUE, rcvid) (* +2.8a *) ELSE (* +2.8a *) openo(rcvname, rcvlength, FALSE, rcvid); (* +2.8a *) rcvbuffer.len := 0; { clear the rcvbuffer } sendACK; currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS; numberoftries := 0; state := REC_DATA; temp_num_pkts := statistics.totalpkts; temp_num_retries := statistics.numretries; temp_time := statistics.stoptime; {starting time is the time} clear_statistics; {that the last transfer } statistics.starttime := temp_Time; {ended } statistics.filename := rcvname; statistics.namelength := rcvlength; statistics.totalpkts := temp_num_pkts + 1; statistics.numretries := temp_num_retries; END; (* of F case *) { Timeout : BEGIN sendNAK; numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); state := ABORT; END; END; } OTHERWISE BEGIN sendNAK; state := ABORT; END; END; (* of case *) UNTIL state <> REC_FILE; END; (* of wait for file-header *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL WAIT FOR A FILE-DATA PACKET FROM THE *) (* CONNECTED KERMIT. *) (* *) (***************************************************************************) PROCEDURE wait_for_filedata; BEGIN (* wait for file-data *) REPEAT receivepacket; CASE receivedpacket.typ OF D : BEGIN IF receivedpacket.seq = currentpacket THEN BEGIN fillrcvbuffer; sendACK; currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKET S; numberoftries := 0; statistics.totalpkts := statistics.totalpkts + 1; END ELSE IF receivedpacket.seq = (currentpacket - 1) MOD MAXNUMBEROFPACKETS THEN BEGIN sendACK; numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); closef (rcvid); (* +2.8a *) state := ABORT; END; END ELSE BEGIN senderror('Unexpected sequence number', 26); closef (rcvid); (* +2.8a *) state := ABORT; END; END; Z : BEGIN IF receivedpacket.seq = currentpacket THEN BEGIN sendACK; statistics.totalpkts := statistics.totalpkts + 1; WITH rcvbuffer DO IF len > 0 THEN { empty out the rcvbuffer } BEGIN (* IF data [len]=LF -2.8a *) (* THEN -2.8a *) (* len := len - 1; -2.8a *) (* WRITELN (rcvfile, data:len); -2.8a *) putbuf (rcvid, ADDR(data), len); (* +2.8a *) len := 0; END; (* CLOSE(rcvfile); -2.8a *) closef (rcvid); (* +2.8a *) currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKET S; numberoftries := 0; state := REC_FILE; CAL_$GET_LOCAL_TIME(statistics.stoptime); statistics.completed := TRUE; IF logging.transactions THEN log_transaction; END ELSE BEGIN senderror('Unexpected sequence number', 26); closef (rcvid); (* +2.8a *) state := ABORT; END; END; F : BEGIN IF receivedpacket.seq = (currentpacket - 1) MOD MAXNUMBEROFPACKETS THEN BEGIN sendACK; numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); closef (rcvid); (* +2.8a *) state := ABORT; END; END ELSE BEGIN senderror('Unexpected sequence number', 26); closef (rcvid); (* +2.8a *) state := ABORT; END; END; Timeout, Checksum_error : BEGIN sendNAK; numberoftries := numberoftries + 1; statistics.numretries := statistics.numretries + 1; IF numberoftries > MAXTRIES THEN BEGIN senderror('Maxtries exceeded', 17); closef (rcvid); (* +2.8a *) state := ABORT; END; END; OTHERWISE BEGIN senderror('Unexpected packet type', 22); closef (rcvid); (* +2.8a *) state := ABORT; END; END; (* of case *) UNTIL state <> REC_DATA; END; (* of wait for file-data *) BEGIN (* receive some files *) statistics.totalpkts := 0; statistics.numretries := 0; IF mode = local THEN BEGIN PAD_$CREATE_FRAME(ERROUT, 80, 25, status); WRITELN(ESC, '[1;1H'); printheader; WRITELN; WRITELN('Packets : ', statistics.totalpkts:1); WRITELN('Retries : ', statistics.numretries:1); END; REPEAT IF debug THEN WRITELN(debugfile, 'STATE : ', ORD(state)); statistics.collecting := TRUE; CASE state OF REC_INIT : BEGIN wait_for_send_init; END; REC_FILE : BEGIN wait_for_fileheader; END; REC_DATA : BEGIN wait_for_filedata; END; OTHERWISE BEGIN statistics.collecting := FALSE; EXIT; END; END; (* of case *) UNTIL FOREVER; IF mode = local THEN PAD_$DELETE_FRAME(ERROUT, status); END; (* of receive some files *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL EXECUTE THE EXIT COMMAND. IT WILL DEASSIGN *) (* ALL DEVICES, CLOSE ALL FILES, AND PLACE THE STREAMS BACK TO THEIR *) (* ORIGINAL STATE. *) (* *) (******************************************************************************) PROCEDURE quit; BEGIN (* quit *) restore_system; PFM_$ENABLE; { enable asynchronous faults... typing a ^Q } PGM_$EXIT; END; (* of quit *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL INITIALIZE THE SYSTEM FOR THE KERMIT SEND/ *) (* RECEIVE STATES. THIS INVOLVES PLACING THE INPUT AND OUTPUT STREAMS INTO *) (* RAW AND NO-ECHO MODES. IT ALSO INVOLVES SETTING THE EVENTCOUNTER POINTERS *) (* TO POINT TO THE CURRENT EVENTCOUNTERS. *) (* *) (******************************************************************************) PROCEDURE initialize_for_send_receive; VAR status : STATUS_$T; BEGIN (* initialize for send-receive *) SIO_$CONTROL(sio_stream, SIO_$RAW, TRUE, status); SIO_$CONTROL(sio_stream, SIO_$NO_ECHO, TRUE, status); initialize_eventpointers; END; (* of initialize for send-receive *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE INITIATES THE SERVER MODE. *) (* *) (******************************************************************************) PROCEDURE server_waits; VAR index : INTEGER; BEGIN (* server waits *) currentpacket := 0; numberoftries := 0; REPEAT receivepacket; IF receivedpacket.seq = 0 THEN BEGIN CASE receivedpacket.typ OF S : BEGIN (* Send Initiate *) processparams; WITH packet[currentpacket] DO BEGIN mark := markchar; typ := Y; len := createsendinitdata(data) + 3; seq := currentpacket; END; (* of with *) sendpacket(currentpacket); currentpacket := (currentpacket + 1) MOD MAXNUMBEROFPACKETS; numberoftries := 0; state := REC_FILE; END; (* of S case *) R : BEGIN (* Receive Initiate *) xmtname := receivedpacket.data; xmtlength := receivedpacket.len - 3; IF xmtlength < MAXDATALENGTH THEN FOR index := xmtlength+1 to MAXDATALENGTH DO xmtname[index] := SP; state := SEND_INIT; END; (* of R case *) G : BEGIN (* Generic Kermit Command *) IF (receivedpacket.data[1] = 'F') OR (receivedpacket.data[1] = 'L') THEN BEGIN sendACK; quit; END; END; (* of G case *) Timeout : BEGIN IF sendservNAKs THEN sendNAK; END; (* of Timeout case *) OTHERWISE BEGIN senderror('Unimplemented server command', 28); END; END; (* of case *) END (* of then *) ELSE IF receivedpacket.typ = Timeout THEN sendNak; UNTIL state <> REC_SERVER_IDLE; END; (* of server waits *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND A GENERIC FINISH COMMAND TO THE *) (* CONNECTED KERMIT. *) (* *) (******************************************************************************) PROCEDURE send_finish; BEGIN (* send finish *) IF mode = host THEN BEGIN WRITELN('Warning : The FINISH command can only be used in local ', 'mode.'); RETURN; END ELSE BEGIN open_sio_line; IF sio_line_opened THEN initialize_for_send_receive ELSE RETURN; END; currentpacket := 0; numberoftries := 0; WITH packet[currentpacket] DO BEGIN mark := MARKCHAR; typ := G; data := 'F'; len := 4; seq := currentpacket; END; REPEAT sendpacket(currentpacket); IF receivedACK THEN BEGIN restore_system; RETURN; END ELSE BEGIN numberoftries := numberoftries + 1; IF numberoftries > MAXTRIES THEN BEGIN WRITELN('Warning : Unable to shutdown connected server.'); restore_system; RETURN; END; END; UNTIL FOREVER; END; (* of send finish *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE EXECUTES THE CONNECT COMMAND. ESSENTIALLY THIS *) (* COMMAND ALLOWS KERMIT TO EMULATE A "SEMI-DUMB" TERMINAL. FOR MORE INFO *) (* PERTAINING TO THE CONNECT COMMAND PLEASE REFER TO THE 'KERMIT USER'S *) (* MANUAL', THE 'KERMIT PROTOCOL MANUAL', OR TO THE HELP FILE. *) (* *) (******************************************************************************) PROCEDURE connect; TYPE xyrcvdstates = (limbo, rcvdESC, rcvd1, rcvdx, rcvdy); VAR connection_ended : BOOLEAN; wakeup : INTEGER; xyseq : RECORD rcvdstate : xyrcvdstates; xpos : INTEGER; ypos : INTEGER; END; (* of xyseq record *) (* The following variables are for handling the graphics primitives *) status : STATUS_$T; cur_position : GPR_$POSITION_T; disp_bm_size : GPR_$OFFSET_T; init_bitmap : GPR_$BITMAP_DESC_T; fwidth : INTEGER; fhite : INTEGER; fid : INTEGER; cur_origin : GPR_$POSITION_T; timeout : TIME_$CLOCK_T; (* The following variables are for the clean-up handler which is used *) (* to ensure that the keyboard is returned to its initial state *) handler_rec : PFM_$CLEANUP_REC; (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL CLEAR THE DATA STRUCTURES USED FOR *) (* HANDLING THE X-Y POSITIONING ESCAPE SEQUENCE. *) (* *) (***************************************************************************) PROCEDURE clearxy; BEGIN WITH xyseq DO BEGIN rcvdstate := limbo; xpos := -1; ypos := -1; END; END; (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL CLEAR THE CURRENT CURSOR POSITION. *) (* *) (***************************************************************************) PROCEDURE clearpos; VAR bitmap_desc : GPR_$BITMAP_DESC_T; source_window : GPR_$WINDOW_T; source_plane : GPR_$PLANE_T; dest_origin : GPR_$POSITION_T; dest_plane : GPR_$PLANE_T; status : STATUS_$T; BEGIN (* clear position *) GPR_$INQ_BITMAP(bitmap_desc, status); GPR_$SET_BITMAP(bitmap_desc, status); WITH source_window DO BEGIN WITH window_base DO BEGIN x_coord := 0; y_coord := 24*fhite + 7; END; WITH window_size DO BEGIN x_size := fwidth; y_size := fhite; END; END; source_plane := 0; WITH dest_origin DO BEGIN x_coord := cur_position.x_coord; y_coord := cur_position.y_coord - 15; END; dest_plane := 0; GPR_$PIXEL_BLT(bitmap_desc, source_window, dest_origin, status); END; (* of scroll *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SCROLL THE TERMINAL EMULATOR SCREEN BY ONE *) (* FULL LINE. *) (* *) (***************************************************************************) PROCEDURE scroll; VAR bitmap_desc : GPR_$BITMAP_DESC_T; source_window : GPR_$WINDOW_T; source_plane : GPR_$PLANE_T; dest_origin : GPR_$POSITION_T; dest_plane : GPR_$PLANE_T; status : STATUS_$T; BEGIN GPR_$INQ_BITMAP(bitmap_desc, status); GPR_$SET_BITMAP(bitmap_desc, status); WITH source_window DO BEGIN WITH window_base DO BEGIN x_coord := 0; y_coord := fhite+7; END; WITH window_size DO BEGIN x_size := 80*fwidth; y_size := 25*fhite; END; END; source_plane := 0; WITH dest_origin DO BEGIN x_coord := 0; y_coord := 7; END; dest_plane := 0; GPR_$PIXEL_BLT(bitmap_desc, source_window, dest_origin, status); END; (* of scroll *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE SIMPLY OBTAINS THE NEXT CHARACTER FROM THE *) (* SPECIFIED STREAM. THIS PROCEDURE IS ESSENTIALLY THE SAME AS THE *) (* GETCHAR PROCEDURE EXCEPT FOR A FEW MINOR EXCEPTIONS. THE PROCEDURE *) (* WILL NOT TIMEOUT, IF THERE ARE NOT CHARACTERS TO RECEIVE IT JUST *) (* RETURNS. THE PROCEDURE ALLOWS YOU TO SPECIFY WHICH STREAM TO OBTAIN *) (* THE CHARACTER FROM, RATHER THAN OBTAINING THE CHARACTER FROM THE SIO *) (* YOU CAN USE IT TO SELECTIVELY POLL THE KEYBOARD. AND FINALLY, THE *) (* PROCEDURE CAN ONLY BE ACCESSED FROM CONNECT. THIS ENABLES THE CONNECT *) (* PROCEDURE TO EXECUTE SLIGHTLY FASTER TO ALLOW IT TO HANDLE FASTER I/O *) (* LINES. *) (* *) (***************************************************************************) PROCEDURE getch(stream : STREAM_$ID_T; VAR stream_rec : stream_io_typ); VAR key : STREAM_$SK_T; status : STATUS_$T; index : INTEGER; (* for debug *) BEGIN (* get character *) stream_rec.rcvdchar := FALSE; { Assume there is no input } stream_rec.timedout := FALSE; { Since we do not care about timeouts } IF stream_rec.index >= stream_rec.size THEN { we have read everything in this buffer and need a new one } BEGIN STREAM_$GET_CONDITIONAL(stream, ADDR(stream_rec.buffer), MAX_BUFFER_SIZE, stream_rec.ptr, stream_rec.size, key, status); IF status.all <> STATUS_$OK THEN BEGIN WRITELN('Warning : Error reading input in GETCH.'); RETURN; END; IF stream_rec.size = 0 THEN RETURN; IF stream_rec.size < 0 THEN { stream has more to send, buffer overflow } stream_rec.size := MAX_BUFFER_SIZE; stream_rec.index := 0; END; stream_rec.rcvdchar := TRUE; stream_rec.index := stream_rec.index + 1; stream_rec.prevchar := stream_rec.currchar; stream_rec.currchar := stream_rec.ptr^[stream_rec.index]; IF ORD(stream_rec.currchar) > 127 THEN { the 8th bit is set and should be cleared } stream_rec.currchar := CHR(ORD(stream_rec.currchar) - 128); END; (* of get character *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SEND THE SPECIFIED CHARACTER TO THE *) (* SPECIFIED STREAM WITHOUT ANY UNDO DELAY. *) (* *) (***************************************************************************) PROCEDURE putch(stream : STREAM_$ID_T; ch : CHAR); VAR size : INTEGER32; key : STREAM_$SK_T; status : STATUS_$T; bitmap_desc : GPR_$BITMAP_DESC_T; source_window : GPR_$WINDOW_T; source_plane : GPR_$PLANE_T; dest_origin : GPR_$POSITION_T; dest_plane : GPR_$PLANE_T; BEGIN (* put character *) IF (stream <> STREAM_$ERROUT) AND (stream <> STREAM_$STDOUT) THEN BEGIN size := 1; CASE ch OF CR, KBD_$CR : STREAM_$PUT_REC(stream, ADDR(CR), size, key, status); KBD_$LEFT_ARROW, KBD_$BS, BS : STREAM_$PUT_REC(stream, ADDR(BS), size, key, status); KBD_$RIGHT_ARROW, CHR(21) : STREAM_$PUT_REC(stream, ADDR(CHR(21)), size, key, status); KBD_$UP_ARROW, CHR(26) : STREAM_$PUT_REC(stream, ADDR(CHR(26)), size, key, status); KBD_$DOWN_ARROW, LF : STREAM_$PUT_REC(stream, ADDR(LF), size, key, status); KBD_$F1 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('q'), size, key, status); END; KBD_$F2 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('r'), size, key, status); END; KBD_$F3 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('s'), size, key, status); END; KBD_$F4 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('t'), size, key, status); END; KBD_$F5 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('u'), size, key, status); END; KBD_$F6 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('v'), size, key, status); END; KBD_$F7 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('w'), size, key, status); END; KBD_$F8 : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('x'), size, key, status); END; KBD_$R2 : (* CDC-722 F9 KEY *) BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('y'), size, key, status); END; KBD_$R3 : (* CDC-722 F10 KEY *) BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('z'), size, key, status); END; KBD_$R4 : (* CDC-722 F11 KEY *) BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('{'), size, key, status); END; KBD_$F1S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('a'), size, key, status); END; KBD_$F2S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('b'), size, key, status); END; KBD_$F3S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('c'), size, key, status); END; KBD_$F4S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('d'), size, key, status); END; KBD_$F5S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('e'), size, key, status); END; KBD_$F6S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('f'), size, key, status); END; KBD_$F7S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('g'), size, key, status); END; KBD_$F8S : BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('h'), size, key, status); END; KBD_$R2S : (* CDC-722 F9S KEY *) BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('i'), size, key, status); END; KBD_$R3S : (* CDC-722 F10S KEY *) BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('j'), size, key, status); END; KBD_$R4S : (* CDC-722 F11S KEY *) BEGIN STREAM_$PUT_REC(stream, ADDR(RS), size, key, status); STREAM_$PUT_REC(stream, ADDR('k'), size, key, status); END; OTHERWISE STREAM_$PUT_REC(stream, ADDR(ch), size, key, status); END; (* of case *) END ELSE BEGIN GPR_$SET_CURSOR_ACTIVE(FALSE, status); CASE ch OF CR, KBD_$CR : BEGIN cur_position.x_coord := 0; END; LF : BEGIN cur_position.y_coord := cur_position.y_coord + fhite; IF cur_position.y_coord > 24*fhite - 1 THEN BEGIN scroll; cur_position.y_coord := 24*fhite - 1; END; END; KBD_$LEFT_ARROW, KBD_$BS, BS : BEGIN IF cur_position.x_coord - fwidth >= 0 THEN cur_position.x_coord := cur_position.x_coord - fwidth ELSE BEGIN cur_position.x_coord := 79*fwidth; IF cur_position.y_coord-fhite >= fhite-1 THEN cur_position.y_coord := cur_position.y_coord - fhite ELSE cur_position.y_coord := 24*fhite - 1; END; END; KBD_$RIGHT_ARROW, CHR(21) : BEGIN IF cur_position.x_coord + fwidth <= 79*fwidth THEN cur_position.x_coord := cur_position.x_coord + fwidth ELSE BEGIN cur_position.x_coord := 0; IF cur_position.y_coord + fhite <= 24*fhite - 1 THEN cur_position.y_coord := cur_position.y_coord + fhite ELSE BEGIN scroll; cur_position.y_coord := 24*fhite - 1; END; END; END; KBD_$UP_ARROW, CHR(26) : BEGIN IF cur_position.y_coord - fhite >= fhite-1 THEN cur_position.y_coord := cur_position.y_coord - fhite ELSE cur_position.y_coord := 24*fhite - 1; END; KBD_$DOWN_ARROW : BEGIN IF cur_position.y_coord + fhite <= 24*fhite - 1 THEN cur_position.y_coord := cur_position.y_coord + fhite ELSE cur_position.y_coord := fhite - 1; END; CHR(22) : { clear to end of line } BEGIN GPR_$INQ_BITMAP(bitmap_desc, status); GPR_$SET_BITMAP(bitmap_desc, status); WITH source_window DO BEGIN WITH window_base DO BEGIN x_coord := 0; y_coord := 24*fhite + 7; END; WITH window_size DO BEGIN x_size := fwidth*80 - cur_position.x_coord; y_size := fhite; END; END; source_plane := 0; WITH dest_origin DO BEGIN x_coord := cur_position.x_coord; y_coord := cur_position.y_coord - 15; END; dest_plane := 0; GPR_$PIXEL_BLT(bitmap_desc, source_window, dest_origin, status); END; CHR(24) : { clear screen and home } BEGIN GPR_$CLEAR(0, status); cur_position.x_coord := 0; cur_position.y_coord := 24*fhite - 1; GPR_$MOVE(0, 30*fhite - 1, status); GPR_$TEXT('[ Connected to host, type ', 26, status); IF (escape_char < SP) OR (escape_char = DEL) THEN BEGIN GPR_$TEXT('^', 1, status); GPR_$TEXT(ctl(escape_char), 1, status); END ELSE GPR_$TEXT(escape_char, 1, status); GPR_$TEXT(' C to return to the Apollo ]', 28, status); END; CHR(25) : { home } BEGIN cur_position.x_coord := 0; cur_position.y_coord := 24*fhite - 1; END; KBD_$F1, KBD_$F2, KBD_$F3, KBD_$F4, KBD_$F5, KBD_$F6, KBD_$F7, KBD_$F8, KBD_$R2, KBD_$R3, KBD_$R4 : BEGIN { do nothing } END; KBD_$F1S, KBD_$F2S, KBD_$F3S, KBD_$F4S, KBD_$F5S, KBD_$F6S, KBD_$F7S, KBD_$F8S, KBD_$R2S, KBD_$R3S, KBD_$R4S : BEGIN { do nothing } END; OTHERWISE BEGIN clearpos; GPR_$MOVE(cur_position.x_coord, cur_position.y_coord, status); IF (ch < SP) OR (ch = DEL) THEN BEGIN { do nothing } END ELSE BEGIN GPR_$TEXT(ch, 1, status); cur_position.x_coord := cur_position.x_coord + fwidth; IF cur_position.x_coord > 79*fwidth THEN BEGIN cur_position.x_coord := 0; cur_position.y_coord := cur_position.y_coord + fhite; IF cur_position.y_coord > 24*fhite - 1 THEN BEGIN scroll; cur_position.y_coord := 24*fhite - 1; END; END; END; END; (* of otherwise *) END; (* of case *) GPR_$SET_CURSOR_POSITION(cur_position, status); GPR_$SET_CURSOR_ACTIVE(true, status); END; END; (* of put character *) (***************************************************************************) (* *) (* THE FOLLOWING FUNCTION WILL PROCESS THE NEXT KEY STROKE. IF A KEY *) (* STROKE IS PROCESSED THEN TRUE IS RETURNED, OTHERWISE FALSE IS RETURNED. *) (* *) (***************************************************************************) FUNCTION processed_keystrokes : BOOLEAN; CONST breaktime = 200; { this is the amount reccommended by the System } { Programmer's Reference Manual } VAR status : STATUS_$T; { used for sending a break } unobscured : BOOLEAN; event : GPR_$EVENT_T; ch : CHAR; BEGIN (* processed keystrokes *) unobscured := GPR_$COND_EVENT_WAIT(event, ch, cur_position, status); IF event <> GPR_$KEYSTROKE THEN BEGIN keybdin_rec.rcvdchar := FALSE; END ELSE BEGIN keybdin_rec.rcvdchar := TRUE; keybdin_rec.prevchar := keybdin_rec.currchar; keybdin_rec.currchar := ch; END; processed_keystrokes := keybdin_rec.rcvdchar; IF keybdin_rec.rcvdchar THEN BEGIN IF keybdin_rec.prevchar = escape_char THEN BEGIN CASE keybdin_rec.currchar OF 'C', 'c' : BEGIN { close the connection, return to local kermit } connection_ended := TRUE; END; 'S', 's' : BEGIN { show status of the connection } END; 'B', 'b' : BEGIN { send a BREAK signal } SIO_$CONTROL(sio_stream, SIO_$SEND_BREAK, breaktime, status); END; '0' : BEGIN { send a NUL character } putch(ERROUT, NUL); END; 'P', 'p' : BEGIN { Push to local system comman processor } { without breaking the connection } END; 'Q', 'q' : BEGIN { quit logging session transcript } logging.session := FALSE; END; 'R', 'r' : BEGIN { resume logging session transcript } IF sessionlength > 0 THEN { a session file has been defined } logging.session := TRUE ELSE BEGIN WRITELN; WRITELN('Warning : no session file defined.'); WRITELN; END; END; '?' : BEGIN { list all the possible single character } { arguments } WRITELN; WRITELN('Recognized single character arguments ', 'are :'); WRITELN; WRITELN(' C - close the connection'); WRITELN(' B - send a break character'); WRITELN(' 0 - send a NUL character'); WRITELN(' Q - quit logging session transcript'); WRITELN(' R - resume logging session transcript'); WRITELN(' ? - provide this listing'); WRITELN; END; OTHERWISE BEGIN IF keybdin_rec.currchar = escape_char THEN BEGIN (* send it to the display *) IF local_echo THEN WITH keybdin_rec DO BEGIN putch(ERROUT, currchar); END; (* of with *) (* now, send it to the connected system *) putch(sio_stream, keybdin_rec.currchar); (* then clear it in currchar so that the *) (* next keystroke is not interpreted as *) (* a command *) keybdin_rec.currchar := SP; END; END; (* of otherwise *) END; (* of case *) END ELSE BEGIN (* send it to the display *) IF local_echo THEN WITH keybdin_rec DO BEGIN IF currchar = escape_char THEN BEGIN { don't do anything until next keystroke } RETURN; END ELSE putch(ERROUT, currchar); END; (* of with *) (* now, send it to the connected system *) putch(sio_stream, keybdin_rec.currchar); END; (* of else *) END; (* of if rcvdchar *) END; (* of processed keystrokes *) (***************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL CHECK TO SEE IF THERE HAS BEEN ANY INPUT *) (* FROM THE HOST. IF SO THE INPUT WILL BE DISPLAYED. *) (* *) (***************************************************************************) FUNCTION host_active : BOOLEAN; BEGIN (* host active *) IF not sio_line_opened THEN BEGIN host_active := FALSE; RETURN; END; REPEAT getch(sio_stream, strin_rec); host_active := strin_rec.rcvdchar; WITH strin_rec DO BEGIN IF rcvdchar THEN BEGIN IF currchar = ESC THEN BEGIN clearxy; xyseq.rcvdstate := rcvdESC; END ELSE BEGIN WITH xyseq DO BEGIN CASE rcvdstate OF rcvdESC : BEGIN IF currchar='1' THEN rcvdstate := rcvd1 ELSE BEGIN putch(ERROUT, ESC); putch(ERROUT, currchar); clearxy; END; END; rcvd1 : BEGIN xpos := ORD(currchar) - 32; IF xpos < 0 THEN xpos := 0; IF xpos > 79 THEN xpos := 79; rcvdstate := rcvdx; END; rcvdx : BEGIN ypos := ORD(currchar) - 32; IF ypos < 0 THEN ypos := 0; IF ypos > 23 THEN ypos := 23;