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; cur_position.x_coord := xpos*fwidth; cur_position.y_coord := (ypos+1)*fhite - 1; GPR_$SET_CURSOR_ACTIVE(FALSE,STATUS); GPR_$SET_CURSOR_POSITION(CUR_POSITION,STATUS ) ; GPR_$SET_CURSOR_ACTIVE(TRUE,STATUS); clearxy; END; limbo : BEGIN putch(ERROUT, currchar); END; END; (* of case *) END; (* of with xyseq *) END; (* of else *) IF logging.session THEN BEGIN IF currchar = CR THEN WRITELN(sessionfile) ELSE BEGIN IF (currchar < SP) OR (currchar = DEL) THEN BEGIN WRITE(sessionfile, '^', ctl(currchar)) END ELSE WRITE(sessionfile, currchar); END; END; END; END; (* of with *) UNTIL (NOT strin_rec.rcvdchar) OR (EC2_$READ(waitptrs[KEYBD_INDEX]^) > waitvalues[KEYBD_INDEX]); END; (* of host active *) BEGIN (* connect *) IF mode = host THEN BEGIN WRITELN('Warning : The CONNECT command can only be used in LOCAL ', 'mode.'); RETURN; END; clearxy; status := PFM_$CLEANUP(handler_rec); {establish clean-up handler} IF status.all <> PFM_$CLEANUP_SET THEN BEGIN GPR_$DISABLE_INPUT(GPR_$KEYSTROKE, status); GPR_$TERMINATE(FALSE, status); PFM_$SIGNAL(status); END ELSE BEGIN { initialize specifying borrow mode } fwidth := 11; fhite := 23; disp_bm_size.x_size := 1024; disp_bm_size.y_size := 1024; GPR_$INIT(GPR_$BORROW, 1, disp_bm_size, 0, init_bitmap, status); { set up text font that will be used in borrow mode } GPR_$LOAD_FONT_FILE('/sys/dm/fonts/f9x15', 19, fid, status); GPR_$SET_TEXT_FONT(fid, status); { set time-out to 5 seconds } timeout.low32 := 5*250000; timeout.high16 := 0; GPR_$SET_ACQ_TIME_OUT(timeout, status); { enable keystroke event and characters from 0 to 127 which includes } { all keys } GPR_$ENABLE_INPUT(GPR_$KEYSTROKE, [chr(0) .. chr(127), KBD_$CR, KBD_$LEFT_ARROW, KBD_$RIGHT_ARROW, KBD_$UP_ARROW, KBD_$DOWN_ARROW, KBD_$BS, KBD_$F1 .. KBD_$F8, KBD_$F1S .. KBD_$F8S, KBD_$R2 .. KBD_$R4, KBD_$R2S .. KBD_$R4S], status); cur_position.x_coord := 0; cur_position.y_coord := fhite-1; cur_origin.x_coord := 0; cur_origin.y_coord := 8; GPR_$SET_CURSOR_ORIGIN(cur_origin, status); GPR_$SET_CURSOR_POSITION(cur_position, status); GPR_$SET_CURSOR_ACTIVE(TRUE, status); END; open_sio_line; initialize_for_send_receive; connection_ended := FALSE; 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); REPEAT waitvalues[KEYBD_INDEX] := EC2_$READ(waitptrs[KEYBD_INDEX]^); waitvalues[STRIN_INDEX] := EC2_$READ(waitptrs[STRIN_INDEX]^); IF (NOT host_active) AND (NOT processed_keystrokes) THEN BEGIN (* waitvalues[KEYBD_INDEX] := waitvalues[KEYBD_INDEX] + 1; waitvalues[STRIN_INDEX] := waitvalues[STRIN_INDEX] + 1; waitvalues[TIME_INDEX] := EC2_$READ(waitptrs[TIME_INDEX]^) + 15*4 ; { wait 15 secs, ticks 1/4 sec } wakeup := EC2_$WAIT(waitptrs[STRIN_INDEX], waitvalues[STRIN_INDEX], 2, status); *) END; UNTIL connection_ended; GPR_$DISABLE_INPUT(GPR_$KEYSTROKE, status); GPR_$TERMINATE(FALSE, status); restore_system; PFM_$RLS_CLEANUP(handler_rec, status); WRITELN('[ Back at the Apollo ]'); END; (* of connect *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL SCAN THE INPUT line FOR A TOKEN. A TOKEN, *) (* IN THIS SENSE, IS ANY STRING OF CHARACTERS DELIMITED BY A SPACE. THE *) (* SEARCH BEGINS AT index. ON EXIT, index IS RETURNED SUCH THAT IT POINTS TO *) (* THE SPACE WHICH MARKED THE END OF THE TOKEN. THE TOKEN THAT WAS FOUND IS *) (* RETURNED IN token. *) (* *) (******************************************************************************) PROCEDURE gettoken(line : STRING; VAR index : INTEGER; VAR token : STRING); VAR t_index : INTEGER; done : BOOLEAN; BEGIN (* get token *) IF (index < 1) OR (index > 80) THEN BEGIN index := 81; token := ' '; END ELSE BEGIN t_index := 0; token := ' '; WHILE (line[index] = SP) AND (index < 80) DO index := index + 1; DONE := FALSE; REPEAT t_index := t_index + 1; token[t_index] := line[index]; index := index + 1; IF index > 80 THEN done := TRUE ELSE IF line[index] = SP THEN DONE := TRUE; UNTIL done; END; (* of else *) END; (* of get token *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL EXECUTE THE CORRESPONDING COMMAND *) (* *) (******************************************************************************) PROCEDURE processcommand(command : cmdtyps; sentence : STRING; VAR cmdindex : INTEGER); TYPE argrecord = RECORD length : INTEGER; data : ARRAY[1 .. 80] OF CHAR; END; VAR token : STRING; index : INTEGER; (* The following variables are for the LOCAL command *) lcmd : NAME_$PNAME_T; llen : INTEGER; argcount : INTEGER; arg : ARRAY[1 .. 10] OF argrecord; argvector : ARRAY[1 .. 10] OF UNIV_PTR; strcount : INTEGER; strvector : ARRAY[1 .. 2] OF STREAM_$ID_T; inv_mode : PGM_$MODE; reserved : ARRAY[1 .. 8] OF REAL; status : STATUS_$T; (* The following variable is for the send command *) inquiry_attri : STREAM_$IR_REC_T; (* +2.8a *) inquiry_error : STREAM_$INQUIRE_MASK_T; (* +2.8a *) wakeup : INTEGER; (* The following variables are for the show command *) baud : INTEGER; parity : INTEGER; iostatus : INTEGER32; (* The following variables are for the STATISTICS command *) clock : CAL_$TIMEDATE_REC_T; total_time : TIME_$CLOCK_T; total_seconds : INTEGER32; (* The following variables are for the TRANSMIT command *) ch : CHAR; size : INTEGER32; key : STREAM_$SK_T; BEGIN (* processcommand *) CASE command OF CONNECTCMD : BEGIN connect; END; EXITCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : EXIT or QUIT') ELSE IF token <> ' ' THEN WRITELN('Illegal syntax for the EXIT/QUIT command.') ELSE quit; END; FINISHCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : FINISH') ELSE IF token <> ' ' THEN WRITELN('Illegal syntax for the FINISH command.') ELSE send_finish; END; GETCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : GET remote_filespec') ELSE IF token = ' ' THEN WRITELN('Illegal syntax for the GET command.') ELSE IF mode = host THEN WRITELN('Warning : The GET command can only be used', ' in LOCAL mode.') ELSE BEGIN open_sio_line; IF sio_line_opened THEN BEGIN initialize_for_send_receive; currentpacket := 0; rcvname := ' '; rcvlength := 0; WHILE token[rcvlength + 1] <> SP DO BEGIN rcvlength := rcvlength + 1; rcvname[rcvlength] := token[rcvlength]; END; WITH packet[currentpacket] DO BEGIN mark := markchar; typ := R; len := rcvlength + 3; data := rcvname; seq := currentpacket; END; sendpacket(currentpacket); state := REC_INIT; END; END; END; (* of get command *) HELPCMD : BEGIN gettoken(sentence, cmdindex, token); IF token <> ' ' THEN WRITELN('Illegal syntax for the HELP command.') ELSE BEGIN WRITELN; WRITELN('Kermit ', VERSION:VERSIONLENGTH, ' implements the following : '); WRITELN; WRITELN(' CONNECT - go into terminal emulation ', 'mode.'); WRITELN(' EXIT - exits from Kermit.'); WRITELN(' FINISH - shuts down a remote Kermit ', 'in server mode.'); WRITELN(' GET - request a remote Kermit ', 'server to send the'); WRITELN(' specified file.'); WRITELN(' HELP - provides this listing.'); WRITELN(' LOCAL - executes the specified ', 'command on the local ', 'system.'); WRITELN(' LOG - log the specified entity to ', 'the specified file.'); WRITELN(' QUIT - exits from Kermit.'); WRITELN(' RECEIVE - waits for the arrival of a ', 'file or file group.'); WRITELN(' SEND - sends a file to the other ', 'system.'); WRITELN(' SERVER - places Kermit in Server ', 'mode.'); WRITELN(' SET - modifies various parameters ', 'for file transfer.'); WRITELN(' SHOW - displays the values of the ', 'parameters settable by the'); WRITELN(' set command.'); WRITELN(' STATISTICS - give information about the ', 'performance of the most '); WRITELN(' recent file transfer.'); WRITELN(' TAKE - executes Kermit commands ', 'from the specified file.'); WRITELN(' TRANSMIT - send the specified file ', 'without protocol.'); WRITELN; END; END; LOCALCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = ' ' THEN WRITELN('Illegal syntax for the LOCAL command.') ELSE IF token = '?' THEN WRITELN('Syntax : LOCAL command') ELSE BEGIN llen := 0; WHILE token[llen + 1] <> SP DO BEGIN llen := llen + 1; END; argcount := 1; arg[1].length := llen; FOR index := 1 TO llen DO arg[1].data[index] := token[index]; argvector[1] := ADDR(arg[1]); NAME_$GET_PATH(arg[1].data, arg[1].length, lcmd, llen, status); IF status.all <> STATUS_$OK THEN { pathname given is not relative } BEGIN lcmd := '/com/'; FOR index := 6 TO arg[1].length + 5 DO lcmd[index] := arg[1].data[index-5]; llen := arg[1].length + 5; END; gettoken(sentence, cmdindex, token); WHILE token <> ' ' DO BEGIN argcount := argcount + 1; arg[argcount].length := 0; WHILE token[arg[argcount].length+1] <> SP DO BEGIN arg[argcount].length := arg[argcount].length + 1; arg[argcount].data[arg[argcount].length] := token[arg[argcount].length]; END; argvector[argcount] := ADDR(arg[argcount]); gettoken(sentence, cmdindex, token); END; strcount := 2; strvector[1] := STREAM_$STDIN; strvector[2] := STREAM_$STDOUT; inv_mode := [PGM_$WAIT]; PGM_$INVOKE(lcmd, llen, argcount, argvector, strcount, strvector, inv_mode, reserved, status); IF status.all = STATUS_$OK THEN WRITELN('Local command executed OK.') ELSE WRITELN('Error executing local command.'); END; END; LOGCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : LOG [option] [filespec]') ELSE IF (token = 'TRANSACTIONS') OR (token = 'transactions') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('OFF or any valid file name.') ELSE IF (token = 'OFF') OR (token = 'off') THEN BEGIN IF transactlength > 0 THEN CLOSE(transactfile); transactname := ' '; transactlength := 0; logging.transactions := FALSE; WRITELN('Logging of transactions is now off.'); END ELSE IF token = ' ' THEN WRITELN('Illegal syntax for filespec.') ELSE BEGIN IF transactname <> ' ' THEN CLOSE(transactfile); OPEN(transactfile, token, 'UNKNOWN', iostatus); IF iostatus <> 0 THEN BEGIN WRITELN('Unable to open LOG file.'); logging.transactions := FALSE; END ELSE BEGIN transactname := ' '; transactlength := 0; REPEAT transactlength := transactlength + 1; transactname[transactlength] := token[transactlength]; UNTIL token[transactlength] = SP; WRITELN('Logging transactions to ', transactname:transactlength); REWRITE(transactfile); logging.transactions := TRUE; END; END; END ELSE IF (token = 'SESSION') OR (token = 'session') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('OFF or any valid file name.') ELSE IF (token = 'OFF') OR (token = 'off') THEN BEGIN IF sessionlength > 0 THEN CLOSE(sessionfile); sessionname := ' '; sessionlength := 0; logging.session := FALSE; WRITELN('Log file for session is now closed.'); END ELSE IF token = ' ' THEN WRITELN('Illegal syntax for filespec.') ELSE BEGIN IF sessionname <> ' ' THEN CLOSE(sessionfile); OPEN(sessionfile, token, 'UNKNOWN', iostatus); IF iostatus <> 0 THEN BEGIN WRITELN('Unable to open LOG file.'); logging.session := FALSE; END ELSE BEGIN sessionname := ' '; sessionlength := 0; REPEAT sessionlength := sessionlength + 1; sessionname[sessionlength] := token[sessionlength]; UNTIL token[sessionlength] = SP; WRITELN('Logging sessions to ', sessionname:sessionlength); REWRITE(sessionfile); logging.session := TRUE; END; END; END; END; NULLCMD : { do nothing }; RECEIVECMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : RECEIVE') ELSE BEGIN open_sio_line; IF sio_line_opened THEN BEGIN initialize_for_send_receive; state := REC_INIT; END; END; END; SENDCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : SEND filespec') ELSE IF token = ' ' THEN WRITELN('Illegal syntax for the SEND command.') ELSE BEGIN xmtname := ' '; xmtlength := 0; WHILE token[xmtlength + 1] <> SP DO BEGIN xmtlength := xmtlength + 1; xmtname[xmtlength] := token[xmtlength]; END; FOR index := 1 TO xmtlength DO (* +2.8a *) lcmd[index] := xmtname[index]; (* +2.8a *) inquiry_attri.obj_name := lcmd; (* +2.8a *) inquiry_attri.obj_namlen := xmtlength; (* +2.8a *) STREAM_$INQUIRE ([12], STREAM_$NAME_UNCONDITIONAL, (* +2.8a *) inquiry_attri, inquiry_error, status); (* +2.8a *) IF (status.all <> STATUS_$OK) THEN (* +2.8a *) WRITELN('SEND file not found.') (* +2.8a *) ELSE (* +2.8a *) BEGIN (* +2.8a *) open_sio_line; IF sio_line_opened THEN BEGIN initialize_for_send_receive; waitvalues[TIME_INDEX] := EC2_$READ(waitptrs[TIME_INDEX]^) + (4 * send_delay); { ticks 1/4 sec } wakeup := EC2_$WAIT(waitptrs[TIME_INDEX], waitvalues[TIME_INDEX], 1, status); state := SEND_INIT; END; END; (* +2.8a *) END; END; SERVERCMD : BEGIN IF mode = local THEN BEGIN WRITELN('Warning : The SERVER command is intended to ', 'be used when Kermit is a host.'); RETURN; END; gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : SERVER') ELSE IF token <> ' ' THEN WRITELN('Illegal syntax for the SERVER command.') ELSE BEGIN open_sio_line; IF sio_line_opened THEN BEGIN WRITE(' Kermit server running on Apollo host'); WRITE('. Please type your escape sequence '); WRITELN('to'); WRITE(' return to your local machine. Shut'); WRITE(' down the server by typing the Kermit'); WRITELN; WRITE(' FINISH command on your local machine.'); WRITELN; WRITELN; initialize_for_send_receive; state := REC_SERVER_IDLE; server_mode := TRUE; END; END; END; SETCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : SET parameter [option] [value]') ELSE IF (token = 'BAUD-RATE') OR (token = 'baud-rate') OR (token = 'BAUD') OR (token = 'baud') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('110 or 300 or 1200 or 4800 or 9600 or ', '19200') ELSE IF token = '110' THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$SPEED, SIO_$110, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set baud-rate to 110.'); END ELSE IF token = '300' THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$SPEED, SIO_$300, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set baud-rate to 300.'); END ELSE IF token = '1200' THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$SPEED, SIO_$1200, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set baud-rate to ', '1200.'); END ELSE IF token = '4800' THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$SPEED, SIO_$4800, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set baud-rate to ', '4800.'); END ELSE IF token = '9600' THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$SPEED, SIO_$9600, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set baud-rate to ', '9600.'); END ELSE IF token = '19200' THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$SPEED, SIO_$19200, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set baud-rate to ', '19200.'); END ELSE WRITELN('Illegal option for BAUD-RATE ', 'parameter.'); END ELSE IF (token = 'DEBUG') OR (token = 'debug') OR (token = 'D') OR (token = 'd') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('ON or OFF') ELSE IF (token = 'OFF') OR (token = 'off') THEN BEGIN CLOSE(debugfile); WRITELN('Debug mode is now off.'); debug := FALSE; END ELSE IF (token = 'ON') OR (token = 'on') THEN BEGIN OPEN(debugfile, 'kermit_debug', 'UNKNOWN'); REWRITE(debugfile); WRITELN('Debug mode is now on.'); debug := TRUE; END ELSE WRITELN('Illegal option for DEBUG parameter.'); END ELSE IF (token = 'DELAY') OR (token = 'delay') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Any non-negative integer.') ELSE BEGIN send_delay := convert_to_int(token); IF send_delay < 0 THEN BEGIN WRITELN('Illegal option for DELAY ', 'parameter.'); send_delay := DEFAULT_send_delay; END; END; END ELSE IF (token = 'ECHO') OR (token = 'echo') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('ON or OFF') ELSE IF (token = 'ON') OR (token = 'on') THEN BEGIN local_echo := TRUE; WRITELN('Local keystrokes will be echoed.'); END ELSE IF (token = 'OFF') OR (token = 'off') THEN BEGIN local_echo := FALSE; WRITELN('Local keystrokes will not be echoed.'); END ELSE WRITELN('Illegal option for ECHO parameter.'); END ELSE IF (token = 'ESCAPE') OR (token = 'escape') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Any ascii character.') ELSE IF (token = SP) OR (token[2] <> SP) THEN WRITELN('Illegal option for ESCAPE parameter.') ELSE BEGIN escape_char := token[1]; WRITE('The escape character is set to '); IF (escape_char < SP) OR (escape_char = DEL) THEN WRITELN('^', ctl(escape_char)) ELSE WRITELN(escape_char); END; (* of else *) END ELSE IF (token = 'FILE_TYPE') OR (token = 'file_type') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('ASCII or BINARY') ELSE IF (token = 'ASCII') OR (token = 'ascii') THEN BEGIN file_type := ascii; WRITELN('FILE_TYPE is now ASCII'); END ELSE IF (token = 'BINARY') OR (token = 'binary') THEN BEGIN file_type := binary; WRITELN('FILE_TYPE is now BINARY'); END ELSE BEGIN WRITE('Illegal option for the FILE_TYPE '); WRITELN('parameter.'); END; END ELSE IF (token = 'LINE') OR (token = 'line') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('1 or 2') ELSE IF (token = '1') OR (token = '2') THEN BEGIN IF mode <> local THEN BEGIN WRITELN('Warning : the LINE command is ', 'intended to be used when Kermit ', 'is local.'); RETURN; END; IF token = '1' THEN sio_line := 1 ELSE sio_line := 2; END ELSE WRITELN('Illegal option for LINE parameter.'); END ELSE IF (token = 'NAKS') OR (token = 'naks') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('ON or OFF') ELSE IF (token = 'OFF') OR (token = 'off') THEN BEGIN WRITE('Server mode will not send periodic Naks'); WRITELN; sendservNAKs := FALSE; END ELSE IF (token = 'ON') OR (token = 'on') THEN BEGIN WRITELN('Server mode will send periodic NAKs'); sendservNAKs := TRUE; END ELSE WRITELN('Illegal option for NAKS parameter.'); END ELSE IF (token = 'PARITY') OR (token = 'parity') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('ODD or EVEN or NONE') ELSE IF (token = 'ODD') OR (token = 'odd') THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$PARITY, SIO_$ODD_PARITY, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set odd parity.'); END ELSE IF (token = 'EVEN') OR (token = 'even') THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$PARITY, SIO_$EVEN_PARITY, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set even parity.'); END ELSE IF (token = 'NONE') OR (token = 'none') THEN BEGIN SIO_$CONTROL(sio_stream, SIO_$PARITY, SIO_$NO_PARITY, status); IF status.all <> STATUS_$OK THEN WRITELN('Unable to set no parity.'); END ELSE WRITELN('Illegal option for PARITY parameter.'); END ELSE IF (token = 'RETRY') OR (token = 'retry') THEN BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Any non-negative integer.') ELSE BEGIN maxtries := convert_to_int(token); IF maxtries < 0 THEN BEGIN WRITELN('Illegal option for RETRY ', 'parameter.'); maxtries := DEFAULT_maxtries; END; END; END ELSE WRITELN('Undefined SET parameter.'); END; SHOWCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : SHOW [option]') ELSE BEGIN IF NOT sio_line_opened THEN open_sio_line; IF sio_line_opened THEN BEGIN SIO_$INQUIRE(sio_stream, SIO_$SPEED, baud, status); IF status.all = STATUS_$OK THEN BEGIN WRITE('BAUD-RATE : '); CASE baud OF SIO_$50 : WRITELN('50'); SIO_$75 : WRITELN('75'); SIO_$110 : WRITELN('110'); SIO_$134 : WRITELN('134'); SIO_$150 : WRITELN('150'); SIO_$300 : WRITELN('300'); SIO_$600 : WRITELN('600'); SIO_$1200 : WRITELN('1200'); SIO_$2000 : WRITELN('2000'); SIO_$2400 : WRITELN('2400'); SIO_$3600 : WRITELN('3600'); SIO_$4800 : WRITELN('4800'); SIO_$7200 : WRITELN('7200'); SIO_$9600 : WRITELN('9600'); SIO_$19200 : WRITELN('19200'); END; (* of case *) END; (* of if *) END; (* of if *) IF debug THEN WRITELN('DEBUG : on') ELSE WRITELN('DEBUG : off'); WRITELN('DELAY : ', send_delay:1); IF mode = local THEN BEGIN WRITE('ESCAPE CHAR : '); IF (escape_char < SP) OR (escape_char = DEL) THEN WRITELN('^', ctl(escape_char)) ELSE WRITELN(escape_char); WRITE('LOCAL ECHO : '); IF local_echo THEN WRITELN('On') ELSE WRITELN('Off'); END; WRITE('FILE_TYPE : '); IF file_type = ascii THEN WRITELN(' ascii') ELSE WRITELN(' binary'); WRITELN('LINE : ', sio_line:1); IF mode = host THEN IF sendservNAKS THEN WRITELN('NAKS : are sent') ELSE WRITELN('NAKS : are not sent'); IF sio_line_opened THEN BEGIN SIO_$INQUIRE(sio_stream, SIO_$PARITY, parity, status); IF status.all = STATUS_$OK THEN BEGIN WRITE('PARITY : '); CASE parity OF SIO_$ODD_PARITY : WRITELN('odd'); SIO_$EVEN_PARITY : WRITELN('even'); SIO_$NO_PARITY : WRITELN('none'); END; (* of case *) END; (* of if *) END; (* of if *) WRITELN('RETRY : ', maxtries:1); END; (* of if *) END; STATISTICSCMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : STATISTICS') ELSE IF token <> ' ' THEN WRITELN('Illegal syntax for the STATISTICS ', 'command.') ELSE IF statistics.namelength = 0 THEN WRITELN('No statistics currently available.') ELSE BEGIN WITH statistics DO BEGIN WRITELN; WRITELN('Statistics on most recent file ', 'transferred :'); WRITELN; WRITELN(' File name : ', filename:namelength); WRITELN; WRITE(' Transmitted : '); IF completed THEN WRITELN('Successfully') ELSE WRITELN('Unsuccessfully'); CAL_$DECODE_TIME(starttime, clock); WRITELN(' Starting Time : ', clock.hour:1, ':', clock.minute:1); CAL_$DECODE_TIME(stoptime, clock); WRITELN(' 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(' Total time ', ' : ', total_seconds:1, ' seconds'); END; WRITELN(' Total characters transmitted : ', (charssent + charsrcvd):1); WRITELN(' Characters sent : ', charssent:1); WRITELN(' Characters received : ', charsrcvd:1); WRITELN(' Maximum in one packet : ', maxcharsinpkt:1); WRITELN(' Overhead characters sent : ', ovhdsent:1); WRITELN(' Overhead characters received : ', ovhdrcvd:1); WRITE(' Percent overhead : '); IF charssent + charsrcvd = 0 THEN WRITELN('0.00%') ELSE WRITELN((((ovhdsent+ovhdrcvd) / (charssent+charsrcvd))*100):6:2, '%'); WRITE(' Baud-rate : '); IF total_seconds = 0 THEN WRITELN('Not determined') ELSE WRITELN(((charssent+charsrcvd) DIV total_seconds)*10:1); WRITE(' Effective baud-rate : '); IF total_seconds = 0 THEN WRITELN('Not determined') ELSE WRITELN(((charssent+charsrcvd- ovhdsent-ovhdrcvd) DIV total_seconds)*10:1); WRITELN; END; (* of with *) END; (* of else *) END; (* of statistics *) TAKECMD : BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : TAKE filespec') ELSE IF token = ' ' THEN WRITELN('Illegal syntax for the TAKE command.') ELSE BEGIN IF take_mode THEN CLOSE(takefile); OPEN(takefile, token, 'OLD', iostatus); IF iostatus <> 0 THEN BEGIN WRITELN('TAKE file not found.'); take_mode := FALSE; END ELSE BEGIN WRITELN('Taking commands from specified file.'); RESET(takefile); take_mode := TRUE; END; END; END; TRANSMITCMD: BEGIN gettoken(sentence, cmdindex, token); IF token = '?' THEN WRITELN('Syntax : TRANSMIT filespec') ELSE IF token = ' ' THEN WRITELN('Illegal syntax for the TRANSMIT command.') ELSE BEGIN OPEN(transmitfile, token, 'OLD', iostatus); IF iostatus <> 0 THEN WRITELN('TRANSMIT file not found.') ELSE BEGIN RESET(transmitfile); WRITELN('Transmitting specified file...'); open_sio_line; IF sio_line_opened THEN BEGIN size := 1; WHILE NOT EOF(transmitfile) DO BEGIN WHILE NOT EOLN(transmitfile) DO BEGIN READ(transmitfile, ch); STREAM_$PUT_REC(sio_stream, ADDR(ch), size, key, status); END; STREAM_$PUT_REC(sio_stream, ADDR(CR), size, key, status); STREAM_$PUT_REC(sio_stream, ADDR(LF), (* +2.8a *) size, key, status); (* +2.8a *) READLN(transmitfile); END; END; WRITELN('....Transmit complete.'); CLOSE(transmitfile); END; END; END; (* of transmit command *) END; (* of case *) END; (* of processcommand *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE SCANS THE INPUT STRING FOR A VALID KERMIT COMMAND. *) (* THE COMMAND FOUND IS PASSED BACK TO THE CALLING PROCEDURE. *) (* *) (******************************************************************************) PROCEDURE parseforcommand(sentence : STRING; VAR index : INTEGER; VAR cmdfound : cmdtyps); VAR token : string; BEGIN (* parseforcommand *) cmdfound := NULLCMD; index := 1; gettoken(sentence, index, token); IF (token = 'CONNECT') OR (token = 'connect') OR (token = 'C') OR (token = 'c') THEN cmdfound := CONNECTCMD ELSE IF (token = 'EXIT') OR (token = 'exit') OR (token = 'EX') OR (token = 'ex') OR (token = 'E') OR (token = 'e') THEN cmdfound := EXITCMD ELSE IF (token = 'FINISH') OR (token = 'finish') OR (token = 'FI') OR (token = 'fi') OR (token = 'F') OR (token = 'f') THEN cmdfound := FINISHCMD ELSE IF (token = 'GET') OR (token = 'get') OR (token = 'G') OR (token = 'g') THEN cmdfound := GETCMD ELSE IF (token = 'HELP') OR (token = 'help') OR (token = 'H') OR (token = 'h') OR (token = '?') THEN cmdfound := HELPCMD ELSE IF (token = 'LOCAL') OR (token = 'local') OR (token = 'LOC') OR (token = 'loc') THEN cmdfound := LOCALCMD ELSE IF (token = 'LOG') OR (token = 'log') THEN cmdfound := LOGCMD ELSE IF (token = 'QUIT') OR (token = 'quit') OR (token = 'Q') OR (token = 'q') THEN cmdfound := EXITCMD ELSE IF (token = 'RECEIVE') OR (token = 'receive') OR (token = 'R') OR (token = 'r') THEN cmdfound := RECEIVECMD ELSE IF (token = 'SEND') OR (token = 'send') OR (token = 'SEN') OR (token = 'sen') THEN cmdfound := SENDCMD ELSE IF (token = 'SERVER') OR (token = 'server') OR (token = 'SER') OR (token = 'ser') THEN cmdfound := SERVERCMD ELSE IF (token = 'SET') OR (token = 'set') THEN cmdfound := SETCMD ELSE IF (token = 'SHOW') OR (token = 'show') OR (token = 'SH') OR (token = 'sh') THEN cmdfound := SHOWCMD ELSE IF (token = 'STATISTICS') OR (token = 'statistics') OR (token = 'ST') OR (token = 'st') THEN cmdfound := STATISTICSCMD ELSE IF (token = 'TAKE') OR (token = 'take') OR (token = 'TA') OR (token = 'ta') THEN cmdfound := TAKECMD ELSE IF (token = 'TRANSMIT') OR (token = 'transmit') OR (token = 'TR') OR (token = 'tr') THEN cmdfound := TRANSMITCMD ELSE IF token <> ' ' THEN WRITELN('Unrecognized command - please reenter.'); END; (* of parseforcommand *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL ASK FOR INPUT FROM THE USER, PARSE THE INPUT *) (* TO SEE IF IT IS A VALID COMMAND, AND IF SO WILL RETURN THE COMMAND. IF *) (* THE INPUT IS NOT A VALID COMMAND THEN THE PROCEDURE WILL SIMPLY ASK FOR *) (* MORE INPUT. *) (* *) (******************************************************************************) PROCEDURE getcommand(VAR command : cmdtyps; VAR sentence : STRING; VAR index : INTEGER); BEGIN (* getcommand *) IF not take_mode THEN REPEAT WRITE('Kermit-apollo> '); READLN(sentence); parseforcommand(sentence, index, command); UNTIL command <> NULLCMD ELSE BEGIN IF EOF(takefile) THEN BEGIN command := NULLCMD; CLOSE(takefile); take_mode := FALSE; END ELSE REPEAT READLN(takefile, sentence); parseforcommand(sentence, index, command); UNTIL (command <> NULLCMD) OR EOF(takefile); END; END; (* of getcommand *) (******************************************************************************) (* *) (* THE FOLLOWING PROCEDURE WILL PROCESS COMMANDS FROM THE CONTROL CARD. *) (* *) (******************************************************************************) PROCEDURE process_command_arguments; VAR status : STATUS_$T; maxlen : INTEGER; argnumber : INTEGER; argument : STRING; arglength : INTEGER; index : INTEGER; cmd : cmdtyps; BEGIN (* process command arguments *) maxlen := 255; argnumber := 1; argument := ' '; arglength := PGM_$GET_ARG(argnumber, argument, status, maxlen); WHILE status.all <> PGM_$NO_ARG DO BEGIN parseforcommand(argument, index, cmd); IF cmd <> NULLCMD THEN processcommand(cmd, argument, index) ELSE WRITELN('Invalid command : ', argument); argnumber := argnumber + 1; argument := ' '; arglength := PGM_$GET_ARG(argnumber, argument, status, maxlen); END; END; (* of process command arguments *) (******************************************************************************) (* *) (* THE FOLLOWING IS THE MAIN DRIVER FOR KERMIT. *) (* *) (******************************************************************************) BEGIN (* KERMIT *) initialize; WRITELN; printheader; WRITELN; (* Set up a clean-up handler to ensure that the sio lines are restored to *) (* their initial states. *) status := PFM_$CLEANUP(handler_rec); IF (status.all <> PFM_$CLEANUP_SET) THEN BEGIN IF debug THEN BEGIN subsys_t := ' '; module_t := ' '; code_t := ' '; ERROR_$GET_TEXT(status, subsys_t, subsys_l, module_t, module_l, code_t, code_l); WRITELN(debugfile, 'Program aborted due to unexpected error -'); IF subsys_l > 0 THEN WRITELN(debugfile, ' Subsystem name : ', subsys_t:-1); IF module_l > 0 THEN WRITELN(debugfile, ' Module name : ', module_t:-1); IF code_l > 0 THEN WRITELN(debugfile, ' Diagnostic text : ', code_t:-1); END; restore_system; PFM_$SIGNAL(status); quit; END ELSE PFM_$INHIBIT; { inhibit asynchronous faults... typing a ^Q } process_command_arguments; REPEAT IF debug THEN WRITELN(debugfile, 'STATE : ',ORD(state)); CASE state OF START : BEGIN getcommand(command, sentence, sentenceindex); IF command = NULLCMD THEN WRITELN(' Invalid command - please reenter.') ELSE processcommand(command, sentence, sentenceindex); END; (* of start *) REC_SERVER_IDLE : BEGIN server_waits; END; (* of server *) SEND_INIT, SEND_FILE, SEND_DATA, SEND_EOF, SEND_BREAK : BEGIN IF (state = SEND_INIT) OR (state = SEND_FILE) THEN BEGIN clear_statistics; END; send_the_files; END; COMPLETE : BEGIN IF server_mode THEN state := REC_SERVER_IDLE ELSE BEGIN restore_system; state := START; END; END; REC_INIT, REC_FILE, REC_DATA : BEGIN IF state <> REC_DATA THEN BEGIN clear_statistics; END; receive_some_files; END; ABORT : BEGIN CAL_$GET_LOCAL_TIME(statistics.stoptime); statistics.completed := FALSE; IF server_mode THEN state := REC_SERVER_IDLE ELSE BEGIN restore_system; state := START; END; END; END; (* of case *) UNTIL FOREVER; END. (* KERMIT *) (*---------------- end --- of --- kermitb.pas ---------------------------*) module kermitio; %include '/sys/ins/base.ins.pas'; %include '/sys/ins/streams.ins.pas'; %include '/sys/ins/pfm.ins.pas'; %include '/sys/ins/type_uids.ins.pas'; { redefines stream to be of undefined structure } procedure undef_stream (sid: integer16); var errmask: stream_$redef_mask_t; status: status_$t; attrib: stream_$ir_rec_t; begin { SR9 does not allow redefining UASC to HDRU. Therefore this stuff has to be commented out ! attrib.rec_type := stream_$undef; attrib.otype := hdr_undef_$uid; attrib.opos := stream_$write; stream_$redefine (sid, [8,11,22], attrib, errmask, status); if status.all <> 0 then pfm_$error_trap (status) } end; { open a stream for input } procedure openi (fn: string; fnlen: integer16; text: boolean; var sid: integer16); var status: status_$t; errmask : stream_$redef_mask_t; attrib : stream_$ir_rec_t; begin stream_$open (fn, fnlen, stream_$read, stream_$unregulated, sid, status); if status.all <> 0 then pfm_$error_trap (status); attrib.explicit_ml := true; { set move mode } stream_$redefine (sid, [6], attrib, errmask, status); if not text then undef_stream (sid) end; (* open a stream for output +2.8a *) procedure openo (fn: string; fnlen: integer16; text: boolean; var sid: integer16); var status: status_$t; errmask : stream_$redef_mask_t; attrib : stream_$ir_rec_t; begin if text then stream_$create (fn, fnlen, stream_$make_backup, stream_$no_conc_write, sid, s tatus) else stream_$create_bin (fn, fnlen, stream_$make_backup, stream_$no_conc_write, si d, status); if status.all <> 0 then pfm_$error_trap (status); attrib.explicit_ml := true; { set move mode } stream_$redefine (sid, [6], attrib, errmask, status); if status.all <> 0 then pfm_$error_trap (status); end; { close a stream } procedure closef (sid: integer16); var status: status_$t; begin stream_$close (sid, status); if status.all <> 0 then pfm_$error_trap (status) end; { read a record (for text file) or a requested number of bytes (for unstructured file) from a stream } procedure getbuf (sid: integer16; bufptr: univ_ptr; buflen: integer32; var retlen: integer32; var eos: boolean); var dummyp: univ_ptr; sk: stream_$sk_t; status: status_$t; len: integer32; begin stream_$get_rec (sid, bufptr, buflen, dummyp, retlen, sk, status); if status.all <> 0 then begin if status.subsys = stream_$subs and then status.code = stream_$end_of_file then begin retlen := 0; eos := true end else pfm_$error_trap (status) end else eos := false; if not eos and then retlen < 0 then len := buflen else len := retlen; end; (* write a record to a stream +2.8a *) procedure putbuf (sid: integer16; bufptr: univ_ptr; buflen: integer32); var sk: stream_$sk_t; status: status_$t; begin stream_$put_rec (sid, bufptr, buflen, sk, status); if status.all <> 0 then pfm_$error_trap (status); end; (*---------------- end --- of --- kermitio.pas ---------------------------*)