// KERMIT V 3.9 MAY 89 G.J.S. // Kermit is a product of Columbia University Centre for Computing Activities. // This version and v. 3.6 developed by G. Sands ,Marconi Space Systems for // standard OS4000. // V. 3.8 by J. Campbell, Physics dept, Univ. of Birmingham (standard OS). // All other versions by M. J. Loach , RAL , for RAL OS4000. // This version runs on standard GEC with no patching. // NOTE: only verified on TF terminals with PCC // // Intended for use with the GEC version of OS4000, note that changes // may be required for use on RAL OS4000, viz , the /!RAL/! and /!GEC/! // flagged lines. This version will be ready to compile for GEC version. // In order to compile for standard RAL system, comment out /!GEC/! lines // and reinstate /!RAL lines. // // // // "Permission is granted to any individual or institution to copy or use // this program, except for explicitly commercial purposes." // Routines added since 2.1 // SERVER_CONTROL // DEBRIEF // FILE_PARSER // EN_PREFIX // DE_PREFIX // FILE_DE_PREFIX // IOERR // Work done since 2.1 // 1. NX() was still used into Kermlog, has been changed // 2. Message from Sfile faulty // 3. Code in Sfile re-written // 4. Server provided, with help etc, Rinit and Parser modified to suit // 5. I/O buffers enlarged, prevents overwriting of log // 6. Packet size increased to 94 for send, and 80 for receive. // 7. DM Error codes written to logfile after dmconnect. (PRRA) // 8. ENPREFIX added, extracted from BUFILL // 9. DEPREFIX added, extracted from BUFEMP //10. LEN in SFILE replaced by LF (bug) in error messages. //11. DEPREFIX added to Server_control for R filename packets. //11A.Prefixing 8 bit quoting now handled if been agreed, not only if Binfile. //12. Repeat count prefixing added. //13. Rtypecheck added to allow GEC version of Rfile to compile. //14. Sfile now does filename conversion to normalform on option . //15. Hashfile(Rfile) now does filename conversion to normalform on option. //16. Shower now displays Off/On instead of 1/0. //17. Extra debug message, 'oname receiving as newname' //18. file_de_prefix added to de prefix rec f paks and server R pak. //19. en_prefixing put into Sfile, mainly for & i suppose... //20. Bufemp modified to restrict the length of text file records to 235. //21. RECEIVE modified to allow one parameter to specify a receive filename. //22. If WITH stream specified in process call then take commands from file. // // Mods for 3.1 // // 1. Generic logout included to stop Kermit but no logout, + error message. // 2. Other Generic commands generate error condition. // 3. I packets get error message only if quoting not agreed in Binary mode. // // Mods for 3.2 // // 1. /!GEC/! version failed if timeout, fixed. // // Mods for 3.3 // // 1. RPAR changed to handle 'Y' in incoming init QBIN parameter correctly. // 2. DE_PREFIX comment altered and EN_PREFIX changed to do 11A above correctly // // Mods for 3.4 // // 1. LAST_RETRY added to RPACK to allow checking for a change of reason for // retry, in which case the NUMTRY count must be reset. Formerly, five // timeouts followed by six checksum errors would have exceeded the limit. // 2. SET SIZE added to allow changing RPSIZ for protocol variants. // // Mods for 3.5 // // 1. MAXL is redefined by F DE CRUZ as max Len instead of max packet size. // Therefore SPSIZ and RPSIZ go down by 2. Alter RPAR and Buffil. Removed // the extra character margin from the check, SPSIZ-8 +2 +1 is SPSIZ-5. // But also there is a bug in that loop can continue to 5 more chars, not // 3, so we get SPSIZ-7. // // Mods for 3.6 // Version 3.6 was produced by G Sands, Marconi for Physical mode. // // 1. File transfer is done with the terminal in physical mode. This takes // care of ?s,linelength restrictions and echo suppression. Also there is a // very handy "PUT followed by a timed-out GET" construction. This is used // whenever a response is expected to a packet being sent. It is also used, // with an empty PUT, when awaiting an initial packet from the other end. // This construction has the advantage that the GET is cancelled if it is // timed out. // 2. "Reset terminal to default" instruction is followed by "set backspace=?C". // 3. /Z... has been added to &KERMLOG, to avoid long transfers crashing when // debug is on. // 4. RPSIZ and limit on SPSIZ in RPAR increased to 94. // 5. Since the PUT-GET time limit is in seconds not millis and is specified in // RX, TIMEOUTs are in seconds and are HALFs (DELAY remains in millis.). // Timeout is set only when entering physical mode or when changed, not at // each GET. // 6. HELP SET refers to &KERMLOG not .KERMLOG. // 7. If receiving and get packet N-1, ack N-1 not N. // 8. "Now type local ..." added to RECEIVE and SEND. // 9. Data management errors on send or recieve files are reported - not fatal. // // Routines altered: // NEXTC new buffer is got with a PUT-GET with an empty PUT, // Tests SPACK_TIMEOUT before anything else. // RPACK reset changed for physical after ^Z. 3 ll after =>NUM, // (0) added after RETURN. // SPACK if LISTEN=1, does a PUT-GET. If data recieved, sets // POINTER for NEXTC to return 1st chara in buffer. Resets // LISTEN to 1 on exit. If timeout, flags to NEXTC. // RPAR limit on SPSIZ is 94. TIMEOUT in secs. // ERROR 0=>LISTEN before SPACK // RTYPECHECK OPEN options changed. // RFILE 0=>LISTEN before ack-ing 'B' packet. If get packet // N-1 ack that not N. // RDATA ack N-1 not N. Trap 'A' from BUFEMP. Trap DMAN error on // PUT. // DE_PREFIX Bug fix as mentioned in 00MAIL90. // BUFEMP Trap DMAN error on PUT. // SFILE OPEN options changed. Trap 'A' from BUFILL. // GETC Trap DMAN error and return -2 on GET. // BUFILL Trap -2 from GETC, pass on. // SDATA Trap 'A' from BUFILL. // DEBRIEF PUT to INSTREAM not OUTSTREAM, follow with CRLF (both // due to physical mode). WAIT removed. // SERVER_CONTROL initialisation changed for physical mode. Return to // logical before resetting terminal. 0=>LISTEN before // ack-ing 'F'. Set timeout when changed. // PARSER TIMEOUT in secs. // MAIN transfer initialisation changed for physical mode and // timeout set. Return to logical before resetting // terminal. IF REMOTE and RFLG or SFLAG output // "Now type local ... ". // // // Mods for 3.7 // // 1. DE_PREFIX last line, save of ra to databuf included to correct // bug causing only first decoded repeated char to be correct. // 2. EN_PREFIX test in first line changed to test for state S, this // caused repeating to not be done on first packet from file. // 3. EN_PREFIX and GETC heavily hacked to get repeat count prefixing // to work properly on Binary file transfers, particularly when // 2-3 reps were found at the end of a record. // 4. RDATA AND RFILE altered so that acks for previous packets received // again are correctly numbered with the previous packet number. This // fix includes correcting the packet length of the first ack in RDATA // to zero. // 5. Length of INBUF extended so that GETC can read records up to // 1024 in length. // 6. Attributes Z(1,1,127) added to Kermlog open to provide larger // extension. // 7. Missing RETURN with RA set to zero corrected in RPACK // (after 'TYPE' decoded) // 8. Comments relating to NUM and N corrected. // // Mods for 3.8 // 1. Version 3.6 for tf/tc merged with version 3.7 // 2. Generic command 'T' added for remote typing of file. // // Mods for 3.9 // // 1. Test for EOF added in EN_PREFIX (otherwise if last chara. of file is a // null get infinite loop). // 2. In GETC, extra trap on BINEOF. Otherwise infinite loop if file ends with // same chara. repeated 2 or 3 times. // 3. Trap ctrlZ throughout RPACK. Trap premature CR & packet not being followed // by CR - treat as checksum error. // 4. ROUTINE CLOSEDOWN added, principally to avoid displacement errors. // 5. Version 3.6 mods reintroduced in PRRA, DEBRIEF, RDATA, BUFEMP and // SERVER_CONTROL. // 6. Minor bug fixes to GETC, SEOF, BUFEMP and BUFILL. // 7. Repeat CONTROLs if timeout. If parity not stripped, mask whole buffer in // one go. // 8. If nothing to do, exit before going physical. // 9. Prevent normalised name starting with a digit. // 10. If RECEIVE , ensure group doesn't go to same file. // // **************************************************************************** DATA CHAPTER MDAT LITERAL INSTREAM=1, // stream for control input OUTSTREAM=2, // stream for output to control(terminal) TEXTIN=0, // open option for text input TEXTOUT=1, // open option for text output BININ=2, // open option for binary input BINOUT=3, // open option for binary output CR=13, // carriage return constant LOGSTREAM=10, // log file for debug info etc FILESTREAM=12, // stream for writing files received READSTREAM=11, // stream for reading files to send WITHSTREAM=5 // stream for reading commands from TAKE file // **************************************************************************** VECTOR [0,237] OF BYTE TITLE=("~", "KERMIT file transfer utility, Version 40/3.9 for GEC 4000 by G Sands,Marconi~", " Kermit-Copyright Columbia University Centre for Computing Activities, 1988 ~", "~Help knows about_ SEND,RECEIVE,SET,SHOW,STATUS,SERVER,HELP,END,BYE,EXIT", " and QUIT~$") VECTOR [0,10] OF BYTE PROMPT="Kermit-40> " // belongs to parser // buffers VECTOR [0,120] OF BYTE BUF // input buffer from remote and also command input VECTOR [0,2] OF BYTE PREBUF // fiddle space for adding things in enprefix VECTOR [0,1023] OF BYTE INBUF // input buffer from files (routine getc) VECTOR [0,1] OF BYTE CHAR VECTOR [0,120] OF BYTE DATABUF // buffer for data in packets VECTOR [0,249] OF BYTE BUFFER // buffer for data going to file (routine bufemp) VECTOR [0,24] OF BYTE MESS ="There is a checksum error" // debug vectors VECTOR [0,120] OF BYTE DBUF // used by dprint VECTOR [0,6] OF BYTE DMESS1 ="RPACK: " VECTOR [0,21] OF BYTE DMESS2="LEN= NUM= TYPE= DATA= " VECTOR [0,6] OF BYTE DMESS3="SPACK: " VECTOR [0,14] OF BYTE DMESS4="RECSW: STATE= " VECTOR [0,33] OF BYTE DMESS5="File being opened for sending is: " VECTOR [0,18] OF BYTE DMESS6="Closing input file " VECTOR [0,26] OF BYTE DMESS7="looking for next file......" VECTOR [0,12] OF BYTE DMESS8="New file is- " VECTOR [0,15] OF BYTE DMESS10="SENDSW: STATE= " VECTOR [0,11] OF BYTE DMESS11="Send command" VECTOR [0,14] OF BYTE DMESS12="Receive command" VECTOR [0,13] OF BYTE DMESS13="Receive failed" VECTOR [0,4] OF BYTE DMESS14="done." VECTOR [0,10] OF BYTE DMESS15="Send failed" VECTOR [0,44] OF BYTE DMESS16="File already exists with different attributes" VECTOR [0,57] OF BYTE ERRVEC=("Kermit aborting with the following error from ", "remote host:") VECTOR [0,14] OF BYTE CREFAIL="Cannot create: " VECTOR [0,26] OF BYTE CRETEXT="Cannot open file:(binary?):" VECTOR [0,28] OF BYTE CREBIN="Cannot open file:(textfile?):" VECTOR [0,26] OF BYTE CRETYPE="Cannot open file:(not LS?):" VECTOR [0,21] OF BYTE DMANERR="Data management error " VECTOR [0,10] OF BYTE SENDMESS="Sending as " VECTOR [0,13] OF BYTE RXMESS=" Receiving as " VECTOR [0,37] OF BYTE MESSTIME="Timeout retries exceeded, press return" VECTOR [0,33] OF BYTE MESSTRY="Too many retries, transfer aborted" VECTOR [0,52] OF BYTE MESSYBIT=("8 bit quoting not agreed,", " so can't do binary transfer") VECTOR [0,27] OF BYTE NOTSERV="Unimplemented server command" VECTOR [0,46] OF BYTE BYEMESS="Generic Logout not possible, but Kermit stopped" VECTOR [0,57] OF BYTE SIGNON=("Kermit-40: Server Running, Now type local ", "escape sequence-") VECTOR [0,31] OF BYTE TAKING="Taking commands from With stream" VECTOR [0,18] OF BYTE TAKEN="End of command file" VECTOR [0,13] OF BYTE ABSTOP="Kermit aborted" VECTOR [0,10] OF BYTE STAMP="Kermit-40: " VECTOR [0,3] OF BYTE SINK="SINK" VECTOR [0,1] OF BYTE CRLF=HEX"0D0A" // Not automatic in PHYS // filelist vectors VECTOR [0,96] OF BYTE FILELIST // filelist from command line VECTOR [0,49] OF BYTE FILNAM1 VECTOR [0,49] OF BYTE FILNAM=("%C ", " ") VECTOR [0,49] OF BYTE NEWFILNAM VECTOR [0,22] OF BYTE LOGVEC="&KERMLOG/Z(1,1,127)/ADD" /!GEC/!VECTOR [0,14] OF BYTE ATTRIBUTE='/NEW/Z(1,1,127)' VECTOR [0,3] OF BYTE LSB="/LSB" // command parser VECTOR [0,14] OF BYTE COMMESS="Invalid command" VECTOR [0,47] OF BYTE COMMANDS=("ENDEXITSENDRECEIVESETHELPSHOWSTATUSQUITBYE", "SERVER") VECTOR [0,16] OF BYTE TOOMESS="Excess parameters" VECTOR [0,20] OF HALF MARKS // holds pointers to command and parameter posits VECTOR [0,16] OF BYTE INVPARM="Invalid parameter" VECTOR [0,13] OF BYTE NOHELP="No information" VECTOR [0,21] OF BYTE RANGEMESS="Parameter out of range" VECTOR [0,80] OF BYTE PARAMS=("EOLDEBUGTIMEREMOTEIMAGESTXPADCHARSENDRETRYS", "QUOTETIMEOUT8BITBINARYREPEATNORMALSIZE") VECTOR [0,4] OF BYTE OFF="OFFON" // **************************************************************************** VECTOR [0,475] OF BYTE SHOWVEC=( " Status of SET parameters- ", " Debug is set to ", " Remote is set to ", " Image is set to ", " Eol is set to ", " Stx is set to ", " Pad is set to ", " Char is set to ", " Send is set to ", " Retrys is set to ", " Time is set to ", " Timeout is set to ", " Quote is set to ", " 8bit is set to ", " Binary is set to ", " Repeat is set to ", " Normal is set to ") // **************************************************************************** VECTOR [0,1] OF BYTE HELP VECTOR [0,769] OF BYTE HELP1=("~", " SEND COMMAND ~", " ************ ~~", " (S)END switches Kermit into send mode. There are no mandatory parameters.~", " If no parameters given then the current file is used (%C). Otherwise the ~", " parameters are standard GEC filenames. There is no wildcard. Unless ~", " otherwise switched off with Set Normal Off (see Help Set), filenames are ~", " hashed into 'Normal-form' by removal of directory structures. Following ~", " this command Kermit-40 starts sending the first packets, and local ~", " Kermit should be switched to receive mode straight away. There is a 15 ~", " second (default) delay period allowed. Files are transfered until all ~", " files are sent, or until abort condition occurs. ~$") VECTOR [0,988] OF BYTE HELP2=("~", " RECEIVE COMMAND ~", " *************** ~~", " (R)ECEIVE switches Kermit into receive mode. One parameter is allowed. ~", " If a GEC filename is given as the first parameter then this filename ~", " will be used for the file received from the local Kermit, and if not ~", " the name(s) of file(s) to be created are received from the local ~", " Kermit and, provided Set Normal Off has not been used (see Help Set), ~", " the names are reformatted if necessary to valid GEC names. Any existing ~", " files of the same name will be appended. Following this command ~", " Kermit-40 goes into wait state, until a valid acceptable packet is ~", " received from the local Kermit, whereupon file transfer will continue ~", " until close and break received or abort condition occurs. This Kermit ~", " will then re-enter command mode. ~$") VECTOR [0,1368] OF BYTE HELP3=("~", " SET COMMAND ~", " *********** ~~", " (SET) allows certain parameters to be switched on and off, or set to a ~", " value. The ones available at present are- (s-on/off, n-value) ~", " DEBUG s- If on, debugging information is logged to &KERMLOG, default off~", // REMOTE s-If on, this Kermit will work as a remote device, default on ~", // IMAGE s- If on, image mode, (8 bit transfers, not available on OS4000) ~", " EOL n- set END-OF-LINE character, to ascii value n, default 13(CR) ~", " STX n- set start of packet text sync char to ascii n, default 1 ~", " PAD n- set number of pad characters to preceed each packet, default 0 ~", " CHAR n- set pad character to be ascii n, default 0 (null) ~", " SEND n- set delay before first SEND packet to n secs, default 15 ~", " RETRYS n-set maximum number of sending retries before abort,default 10 ~", " TIME n- set number of seconds before micro-kermit times me out, def 5 ~", " TIMEOUT n- set number of seconds for Kermit-40 timeout, default 10 ~", " QUOTE n- set the ASCII value of the character I send for quoting,def 35 ~", " 8BIT n- set ASCII value of the character I send for 8bit quoting. (38) ~", " BINARY s-If on, LSB files are sent and received, via 8bit quote. (off) ~", " REPEAT n-set ASCII value of the character I send for repeat quote.(126) ~", " NORMAL s-If on, filenames are converted to a 'normal form', default on ~$") VECTOR [0,304] OF BYTE HELP4=("~", " SHOW/STATUS COMMAND ~", " ******************* ~~", " (SH)OW displays the current state of SET parameters and various other ~", " useful information concerning this Kermit. ~$") VECTOR [0,228] OF BYTE HELP5=("~", " HELP COMMAND ~", " ************ ~~", " (H)ELP is this command, so you know how to use it! ~$") VECTOR [0,228] OF BYTE HELP6=("~", " QUIT/EXIT/END/BYE ~", " ***************** ~~", " (Q)UIT, (E)XIT, (E)ND and (B)YE are synonomous commands to stop Kermit ~$") VECTOR [0,608] OF BYTE HELP7=("~", " SERVER COMMAND ~", " ************** ~~", " (SER)VER will invoke the Kermit Server mode. In server mode, Kermit-40 ~", "waits for command packets to be received from the local Kermit. The user ~", "should escape back to the local Kermit and use GET and SEND commands to ~", "receive and send files respectively. The local kermit must be capable of ~", "operation with a remote server. The command FINISH on the local server will~", "switch Kermit-40 back to command mode. ~$") VECTOR [32,126] OF BYTE TABLE= (" !",34,"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ", "[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~") // **************************************************************************** BYTE DEBUG=0, // if 1 then debug mode N=0, // number of outgoing packet NEXTN, // save-space for N NUMTRY=0, // number of times tried to send without ack MAXTRY=10, // max number of times to try resending OLDTRY=0, // previous value STATE, // holds current state of state switcher F_OR_X_FLAG, // file or text transfer REMOTE=1, // set 1 means remote mode , always for this remote kermit IMAGE=0, // set 0 means no image mode, always on this kermit BINFILE=0, // file type being transfered, 1=bin, 0=text FP=0 // indicates if file open for sending EXTERNAL ROUTINE //data management OPEN,CLOSE, // files GET,GETO,PUT, // get lines and put lines to/from streams TOCHAR, // convert ra to string FROMCHAR, // convert string to number in ra CONTROL, // alter defaults affecting LT process DMCONNECT, // connects file name to stream DECODEIO, // used to decode a geto after a message which is not a timeout GETSTREAMARG // used to find out if a With stream has been specified HALF MILLI=1000, // one thousand INBUFLEN=1024, // length of INBUF for GETC REREAD, // flag to show GETC not to read new record when GP<0 RECLEN, // record length for getc DBUFP=0, // hold the pointer for addvec addnum etc FLAG8=0, // flag to indicate an eight bit quote found TIMING=0, // flag to indicate ipm awaited during timeout TIMIDMODE=HEX'8101', // timeout message id and mode are @81 and 1 TIMIDCAN=HEX'8100', // timeout message id for cancel NPACK, // packet number printed in dpack STX=1, // control-a start of packets IB=0, // counter in bufemp NEWARNCH=HEX'02F5', // set warning character in control /!RAL//TERMWIDTH=HEX'02E0', // set terminal width in control /!RAL//HDX=HEX'0011', // set lt to half duplex /!RAL//CONLT=HEX'02E3', // RAL control command /!GEC/!CONLT=HEX'02FE', // for asis control DEFAULT=HEX'02FF', // reset terminal to default ALTCHAR=HEX'02F7', // control code for ?X OFS=0, // offset for writing help messages /!RAL//ATTRIBUTE=LOGVEC+19, // '/add' for filename READFAIL=CRETEXT, // part message for dmconnect EOFPENDING=0, // shows eof found on end of buffer in bufill NOCRLF=HEX'02F0', // mask for data management control /!GEC/!NOECHO=HEX'02F2', // to prevent packets being echoed EVEN=HEX'0FF0', // gets PHYS to expect even parity STOP_ON_CR=HEX'0FF2', // " " " terminate GETs on CR PGTCODE=HEX'0FF9', // PUT-GET time limit control code PUTGET=HEX'0FF8', // " " control code TXIN_ERR=HEX'8000', // open option for text input with non-default error // options TXOUT_ERR=HEX'8001', // ditto for text output BININ_ERR=HEX'8002', // ditto for binary input BINOUT_ERR=HEX'8003', // ditto for binary output ERROPT=HEX'FFFF', // return all DMAN errors to program, don't report // to terminal line // ERROPT_LOCAL=HEX'5555', - return to screen as well. LISTEN=1, // used to decide between PUT-GET and normal PUT. LEN, // length of packet data NUM, // packet number for received packets TYPE, // packet type POINTER=-1, // used in routine nextc PP, // used as parser pointer MASK=HEX'007F', // mask to strip parity bit in nextc ERMASK=HEX'F000', // used after fromchar CCHKSUM, // calculated checksum RCHKSUM, // received checksum value I,J, // scratch temporarys for loop counts etc MASK1=HEX'00C0',MASK2=HEX'003F', // used in checksum calculation POINT, // used by routine dpack INDEX, // counter in spack SAVE, // save location HEXPRINT=256, // tochar mode LF=2, // length of filename (%c) P, // pointer for gnxtfl IP=0, // parm counter for gnxtfl SIZE, // length of data in buffer from send file GP=-1, // routine getc pointer EOFLAG=0, // set to 1 on eof BINEOF=0, // Set to 1 on binary eof if finished on 2 or 3 reps CFLG=0,SFLG=0,RFLG=0, // flags to show mode, one of connect,send,receive NPARMS, // number of parameters found on command line COMSIZ=47, // length of possible commands list LCMASK=HEX'00DF', // mask to force alphas to upper case PARMSIZ=77, // length of possible parameters list(set) SERVER=0, // If 1 indicates server mode entered RCOUNT=1, // Count for repeat prefixing NORMAL=1, // If NOT set normal form conversion of filenames not done TAKE_FILE=0, // If set then Parser will take commands from With stream LAST_RETRY=0, // Indicates reason for last retry. 1 for timeout, 2 for checksum // defaults i assume until init received SPSIZ=65, // max send packet size PAD=0, // how much padding to send EOL=13, // eol character to send PADCAR=0, // pad character to send QUOTE=35, // quote character in incoming data (#) TIMINT=10, // when to time out other Kermit EIGHTQ=78, // eight bit quote in incoming data('n') CHKTYPE=' 1', // checksum type RPEAT=32, // repeat count prefix assumed(sp- not done) // what i want which i ask for in init RPSIZ=94, // largest LEN i can receive MYTIME=5, // when i want to be timed out MYPAD=0, // number of pad chars i want MYPCAR=0, // pad char i want MYEOL=13, // end of line char i want MYQUOTE=35, // control quote char i send (#) MY8BIT=38, // 8 bit quote i send (&) MYCHECK=' 1', // checksum i do MYRPEAT=126 // repeat prefix char i send FULL DMERRMASK=HEX'80000000',EOFMASK=HEX'FFFF0000',EOF=HEX'80000000' END //****************************************************************************** PROGRAM CHAPTER KERMIT GLOBAL DATA CHAPTER MDAT ENTRY LABEL ENTRYPOINT // 'vector table' for parser and help VECTOR [0,47] OF FREE LABEL WHATCOM=(EX,E,E,EX,E,E,E,SE,E,E,E,RE,E,E,E,E,E,E,ST, E,E,HP,E,E,E,SH,E,E,E,SH,E,E,E,E,E,EX,E,E,E,EX,E,E,SV,E,E,E,E,E) VECTOR [0,47] OF FREE LABEL HELPARMS=(HQU,EH,EH,HQU,EH,EH,EH,HSE,EH,EH,EH, HRE,EH,EH,EH,EH,EH,EH,HST,EH,EH,HHP,EH,EH,EH,HSH,EH,EH,EH,HSH,EH,EH,EH,EH,EH, HQU,EH,EH,EH,HQU,EH,EH,HSV,EH,EH,EH,EH,EH) FREE ROUTINE // all these are to avoid displacement errors. NX=FAR_NX, SPACK=FAR_SPACK, RPAR=FAR_RPAR, RPACK=FAR_RPACK, PRERRPKT=FAR_PRERRPKT, DPRINT=FAR_DPRINT, SINIT=FAR_SINIT, RECSW=FAR_RECSW, BUFILL=FAR_BUFILL, SDATA=FAR_SDATA, SEOF=FAR_SEOF, NEXTC=FAR_NEXTC, DPACK=FAR_DPACK, SPAR=FAR_SPAR, RINIT=FAR_RINIT, RFILE=FAR_RFILE, ERROR=FAR_ERROR, SFILE=FAR_SFILE, SENDSW=FAR_SENDSW, HELPER=FAR_HELPER, PARSER=FAR_PARSER, SHOWER=FAR_SHOWER, SERVER_CONTROL=FAR_SERVER_CONTROL, GNXTFL=FAR_GNXTFL, ADDVEC=FAR_ADDVEC, PUTVEC=FAR_PUTVEC, ADDNUM=FAR_ADDNUM, FILE_PARSER=FAR_FILE_PARSER, DEBRIEF=FAR_DEBRIEF, DE_PREFIX=FAR_DE_PREFIX, PRRA=FAR_PRRA, FILE_DE_PREFIX=FAR_FILE_DE_PREFIX, IOERR=FAR_IOERR, CLOSEDOWN=FAR_CLOSEDOWN FREE LABEL FAR_MISS=MISS,FAR_ABORT=ABORT EXTERNAL ROUTE TIMEVENT, IOROUTE // for timeout HALF TIMEOUT=10, // timeout after 10 seconds SERVER_TIMEOUT=30, // timeout during server idle time SAVE_TIMEOUT, // used by server to save value SPACK_TIMEOUT=0 // flags SPACK timeout to NEXTC FULL DELAY=15000, // delay on first send packet SAVE_DELAY, // used by server to save value SAVERA, // save area for timeout event FTYPELS=HEX'000F0000', // filetype logical sequential, for dmconnect FTYPETB=HEX'00200000' // filetype text or binary, for dmconnect //****************************************************************************** ROUTINE FAR_NEXTC() // gets next char from remote, getting new record IF SPACK_TIMEOUT NE //0// THEN << // SPACK puts message in logfile 0 => SPACK_TIMEOUT 1=>TIMING // Controls already reset by SPACK. RETURN(TIMIDMODE) // return with timeout indicated >> IF POINTER LT THEN // if needed. << // Use PUT-GET with an empty PUT. CONTROL(INSTREAM,100,PUTGET) // 100 is GET length PUT(INSTREAM,0,BUF) // and trigger timed // GET(INSTREAM,100,BUF) TEST RA LT //0// THEN << PUT(LOGSTREAM,7,MESSTIME) // record timeout in log file 1=>TIMING // // May have lost controls - re-instate CONTROL(INSTREAM,1,STOP_ON_CR) // terminate gets on cr CONTROL(INSTREAM,1,EVEN) // check and strip even parity CONTROL(INSTREAM,TIMEOUT,PGTCODE) // timeout for put-gets RETURN(TIMIDMODE) // return with timeout indicated >> ELSE << IF DEBUG NE THEN PUT(LOGSTREAM,RX,//BUF//) // write line to logfile 0=>POINTER =>TIMING CR=>BUF[RX] // [RX-1] should be CR,but make sure. >> >> BUF[POINTER] IF(,IMAGE EQ) THEN IF //BUF[POINTER]// GE HEX'80' THEN // MUST HAVE LOST CONTROLS - RE-INSTATE << CONTROL(INSTREAM,1,STOP_ON_CR) // terminate GETs on c. return CONTROL(INSTREAM,1,EVEN) // check and strip even parity. CONTROL(INSTREAM,TIMEOUT,PGTCODE) // timeout for put-gets (,POINTER => RX) REPEAT // mask rest of line. << BUF[RX] & MASK =>BUF[RX] // l.s. 7 bits only (,RX+1 => RX) >> UNTIL //BUF[RX]// EQ CR // there is one 'cos we put one in. BUF[POINTER] => RA >> (,POINTER+1=>POINTER) // char less parity into ra,inc pointer IF EQ CR THEN << 0-1=>POINTER // if end of current record, reset pointer >> // eol is returned to caller to indicate this RETURN(RA) END //****************************************************************************** ROUTINE FAR_DPRINT(SAVE) // prints ra as a 8 char int (,HEXPRINT) TOCHAR(,+8,DBUF) PUT(LOGSTREAM,8,DBUF) RETURN(SAVE) END //****************************************************************************** ROUTINE FAR_NX() // inhibits n/l on next put CONTROL(LOGSTREAM,,NOCRLF) RETURN END //****************************************************************************** ROUTINE FAR_ADDVEC() // adds the vector message in ry to dbuf (,=>SAVE,,RY) MOVE(,,DBUF+DBUFP) (,SAVE+DBUFP=>DBUFP) // incrementing the pointer for the next one RETURN END //****************************************************************************** ROUTINE FAR_ADDNUM() // adds the hex number representing ra into dbuf TOCHAR(,HEXPRINT+8,DBUF+DBUFP) (,DBUFP+8=>DBUFP) // incrementing the pointer for the next string RETURN END //****************************************************************************** ROUTINE FAR_PUTVEC() // writes out the vector created bt addvec and addnum PUT(LOGSTREAM,DBUFP,DBUF) (0=>DBUFP) RETURN END //****************************************************************************** ROUTINE FAR_DPACK(POINT,NPACK) // used by debug in r & s pack // to print len,num,type to screen ADDVEC(,7,POINT) ADDVEC(,5,DMESS2) ADDNUM(LEN) PUTVEC() ADDVEC(,7,POINT) ADDVEC(,5,DMESS2+5) ADDNUM(NPACK) PUTVEC() ADDVEC(,7,POINT) ADDVEC(,5,DMESS2+10) ADDNUM(TYPE) PUTVEC() ADDVEC(,7,POINT) ADDVEC(,6,DMESS2+16) ADDVEC(,LEN,DATABUF) PUTVEC() RETURN END //****************************************************************************** ROUTINE FAR_CLOSEDOWN // shut down all streams, called // with RA=1 if still physical, // 0 otherwise IF RA NE 0 THEN << CLOSE(INSTREAM) OPEN(INSTREAM,TEXTIN) //back to logical CONTROL(INSTREAM,,DEFAULT) CONTROL(INSTREAM,'C' ALSH 8 +8,ALTCHAR) // restore backspace >> CLOSE(INSTREAM) CLOSE(OUTSTREAM) CLOSE(LOGSTREAM) CLOSE(READSTREAM) CLOSE(FILESTREAM) CLOSE(WITHSTREAM) RETURN END //****************************************************************************** ROUTINE FAR_RPACK // receive packet and decode WHILE NEXTC() NE STX AND NE HEX'1A' AND NE TIMIDMODE DO CONTINUE //loop till stx IF EQ TIMIDMODE THEN << IF LAST_RETRY EQ 2 THEN // if change of reason for retry << // then reset counter NUMTRY=>OLDTRY 0=>NUMTRY 1=>LAST_RETRY // say last retry was timeout >> RETURN(0) // return if timeout >> IF EQ HEX'1A' THEN GOTO FAR_ABORT RESTART: // STX found IF NEXTC() EQ STX THEN GOTO RESTART // if found here then error IF EQ TIMIDMODE THEN RETURN (0) IF EQ HEX'1A' THEN GOTO ABORT =>CCHKSUM // init chksum -' '-3=>LEN // unchar and save number of data IF LT THEN 0=>LEN // if silly small ra prevent neg len IF NEXTC() EQ STX THEN GOTO RESTART IF EQ TIMIDMODE THEN RETURN(0) IF EQ HEX'1A' THEN GOTO ABORT (,RA -' ' =>NUM) // unchar and save packet number (+CCHKSUM=>CCHKSUM) // add packet number(char) IF NEXTC() EQ STX THEN GOTO RESTART IF EQ TIMIDMODE THEN RETURN(0) IF EQ HEX'1A' THEN GOTO ABORT (=>TYPE+CCHKSUM=>CCHKSUM) // save packet type char and add 0=>I WHILE I LT LEN DO // loop in data << IF NEXTC() EQ STX THEN GOTO RESTART IF EQ TIMIDMODE THEN RETURN(0) IF LT 0 THEN GOTO BADCHK // premature end-of-line - treat // as bad checksum. IF EQ HEX'1A' THEN GOTO ABORT (=>DATABUF[I]+CCHKSUM=>CCHKSUM) I+1=>I >> 0=>DATABUF[I] // put marker on end IF NEXTC() EQ STX THEN GOTO RESTART IF EQ TIMIDMODE THEN RETURN(0) IF EQ HEX'1A' THEN GOTO ABORT IF LT 0 THEN GOTO BADCHK // premature end-of-line. -' '=>RCHKSUM // save unchared checksum received IF NEXTC() EQ STX THEN GOTO RESTART IF EQ TIMIDMODE THEN RETURN(0) IF EQ HEX'1A' THEN GOTO ABORT IF GE 0 THEN GOTO BADCHK // next chara. should be EOL. CCHKSUM & MASK1 LRSH [6]+CCHKSUM & MASK2=>CCHKSUM // compute my check IF DEBUG NE THEN // if debug mode print things << CALL DPACK(DMESS1,NUM) >> IF CCHKSUM EQ RCHKSUM THEN // finished RETURN(TYPE) // normal return. // errors. BADCHK: // checksums differ or not stated // length. IF LAST_RETRY EQ 1 THEN // if change of reason for retry << // then reset counter NUMTRY=>OLDTRY 0=>NUMTRY 2=>LAST_RETRY // say last retry was checksum >> PUT(LOGSTREAM,25,MESS) // say checksum failed RETURN(0) ABORT: // control-z read. PUT(LOGSTREAM,14,ABSTOP) CLOSEDOWN(1) STOP(1) END //****************************************************************************** ROUTINE FAR_SPACK // make and send packet IF DEBUG NE THEN // if debug mode print things << CALL DPACK(DMESS3,N) >> (,0) // init rx for count WHILE (, LT PAD) DO << PADCAR=>BUF[] // put len pad chars into start of buf (,+1) >> STX=>BUF[RX] // stx on start of packet (,+1) LEN+3+' '=>BUF[]=>CCHKSUM // len+3 chared next (,+1) N+' '=>BUF[]+CCHKSUM=>CCHKSUM // followed by n chared, update sum (,+1) TYPE=>BUF[]+CCHKSUM=>CCHKSUM // and then type as is (,+1) 0=>I // zero i for count RX=>INDEX // and remember rx WHILE (I LT LEN) DO // now insert all data items << DATABUF[I]=>BUF[INDEX]+CCHKSUM=>CCHKSUM (I+1=>I,+1=>INDEX) >> // and then do checksum to send CCHKSUM & MASK1 LRSH[6] + CCHKSUM & MASK2 +' '=>BUF[INDEX]=>CCHKSUM (,+1) EOL=>BUF[] // finish on eol char (,+1=>INDEX) IF DEBUG NE THEN // Debug now 'cos BUF gets clobbered. << ADDVEC(,7,DMESS3) ADDVEC(,INDEX,BUF) PUTVEC() >> TEST LISTEN NE THEN << // Look for reply immediately. CONTROL(INSTREAM,100,PUTGET) // 100 is GET length PUT(INSTREAM,INDEX,BUF) // and trigger timed // GET(INSTREAM,100,BUF) TEST RA LT //0// THEN << PUT(LOGSTREAM,7,MESSTIME) // record timeout in log file // May have lost controls - re-instate CONTROL(INSTREAM,1,STOP_ON_CR) // terminate gets on cr CONTROL(INSTREAM,1,EVEN) // check and strip even parity CONTROL(INSTREAM,TIMEOUT,PGTCODE) // timeout for put-gets 1=>TIMING=>SPACK_TIMEOUT // next call to NEXTC will send timeout >> // to higher level routine. ELSE << IF DEBUG NE THEN PUT(LOGSTREAM,RX,//BUF//) // write line to logfile 0=>POINTER // so NEXTC picks this buffer up =>TIMING =>SPACK_TIMEOUT CR=>BUF[RX] // [RX-1] should be CR,but make sure. >> >> ELSE << // Not LISTEN - conventional PUT PUT(INSTREAM,INDEX,BUF) 1=>LISTEN // LISTEN unless specifically told not. 0=>SPACK_TIMEOUT >> RETURN END //****************************************************************************** ROUTINE FAR_RPAR // receive parameters from other kermit // are put into variables DATABUF[0]-' '=>SPSIZ IF SPSIZ GT 94 THEN 94=>SPSIZ // dont allow LEN to exceed 94 DATABUF[+1]-' '=>TIMINT IF LE THEN 1 // make sure cant do very small timeout =>TIMEOUT // whole secs for timeout DATABUF[+1]-' '=>PAD DATABUF[+1];(,64 XOR RA=>PADCAR) DATABUF[4]-' '=>EOL DATABUF[+1]=>QUOTE IF LEN GT 6 THEN << DATABUF[+1]=>EIGHTQ // remember his request TEST EQ 'Y' THEN MY8BIT=>EIGHTQ // if Yes then choose myself ELSE EIGHTQ=>MY8BIT // else take his choice. >> IF LEN GT 7 THEN DATABUF[+1]=>CHKTYPE IF LEN GT 8 THEN DATABUF[+1]=>RPEAT=>MYRPEAT RETURN END //****************************************************************************** ROUTINE FAR_SPAR // my requirements to send to local RPSIZ+' '=>DATABUF[0] MYTIME+' '=>DATABUF[+1] MYPAD+' '=>DATABUF[+1] (MYPCAR,64 XOR RA);RX=>DATABUF[3] MYEOL+' '=>DATABUF[+1] MYQUOTE=>DATABUF[+1] MY8BIT=>DATABUF[+1] MYCHECK=>DATABUF[+1] MYRPEAT=>DATABUF[+1] RETURN END //****************************************************************************** ROUTINE FAR_PRERRPKT // to print error packet received PUT(LOGSTREAM,58,ERRVEC) // with abort message PUT(LOGSTREAM,LEN,DATABUF) RETURN END //****************************************************************************** ROUTINE FAR_RINIT // compose and send init packet // and get locals parms IF NUMTRY GT MAXTRY THEN RETURN ('A') // if tried too many times give up +1=>NUMTRY TEST SERVER EQ THEN RPACK() // if not server get packet ELSE TYPE // otherwise get packet type TEST EQ 'S' THEN // if sendinit then set parms << RPAR() ; SPAR() // put parms in my vars, send my parms IF BINFILE NE AND EIGHTQ EQ 'N' THEN // if binary file check 8bit quote << // agreed, if not then abort MOVE(,53,DATABUF,MESSYBIT) ERROR(,53) RETURN('A') >> 'Y'=>TYPE;N=>NUM;9=>LEN // send ack init SPACK() NUMTRY=>OLDTRY ; 0=>NUMTRY // save old try count, start new one N+1/64;RB=>N // inc packet modulo 64 RETURN('F') // return as state f >> ELSE << TEST EQ 'E' THEN // otherwise if error abort << PRERRPKT() // print error packet received RETURN('A') >> ELSE << TEST EQ 0 THEN // if packet invalid << 'N'=>TYPE;N=>NUM;0=>LEN // send a nak pak SPACK() RETURN(STATE) // return in same state to retry >> ELSE << RETURN('A') // abort if undefined, cant go on >> >> >> END //****************************************************************************** ROUTINE ALPHA // test if RA is alpha-numeric. TEST( GE '0' AND LE '9')OR( GE 'A' AND LE 'Z')OR( GE 'a' AND LE 'z')THEN 0 ELSE TEST EQ '.' OR EQ '%' OR EQ '&' THEN 2 ELSE 1 RETURN END //****************************************************************************** ROUTINE FAR_ERROR // process error, if this is a remote kermit then // send error packet to local screen, TEST REMOTE NE THEN << MOVE(,=>LEN,DATABUF+11,DATABUF) // Move up message MOVE(,11,DATABUF,STAMP) // add in 'kermit-40' stamp (,LEN+11=>LEN) PUT(LOGSTREAM,LEN,DATABUF) // copy to log file 'E'=>TYPE;0=>LISTEN;SPACK() // may not be expecting reply >> ELSE << // if local only PRERRPKT() // display on this screen. >> RETURN END //****************************************************************************** ROUTINE HASHFILE // this is the invalid char filter REPEAT << ALPHA(DATABUF[]) // alpha/num char?? IF NE 1 THEN << IF EQ 0 OR NORMAL NE 1 THEN // if so then copy over << DATABUF[];(,=>SAVE);=>NEWFILNAM[RY];(,SAVE,+1) >> >> (,+1) // next char to check >> UNTIL (,RX EQ LEN) // until all copied/filtered (,,RY=>SAVE) // store length of NEWFILNAM. // this prunes to size and adds the statutary '.' TEST NORMAL NE THEN // if normalform to be done << IF (,RY GT 8) THEN (,8) // check max filename size (,=>LEN=>RY) // save it as new len, copy to Y // now check that 1st chara of new name isn't a digit. (,SAVE-LEN=>RX) // index of 1st chara. WHILE NEWFILNAM[RX] GE '0' AND LE '9' AND (,,RY GT 0) DO (,RX+1,RY-1) TEST (,,RY EQ 0) THEN // all digits. Make 1st an X. 'X' => NEWFILNAM[SAVE-LEN] // LEN unchanged. ELSE (,,RY=>LEN) MOVE(,LEN,FILNAM1+1,NEWFILNAM+SAVE-LEN) // copy it,leaving space for '.'=>FILNAM1[0];LEN+1=>LEN // period on front >> ELSE // if not normalform << (,SAVE=>LEN) // use full length. MOVE(,,FILNAM1,NEWFILNAM) // dont leave space for '.' >> /!RAL// MOVE(,4,FILNAM1+LEN,ATTRIBUTE) // concatenate /add /!RAL// LEN+4=>LEN /!GEC/! MOVE(,15,FILNAM1+LEN,ATTRIBUTE) // /NEW/Z(1,1,127) /!GEC/! LEN+15=>LEN IF BINFILE NE THEN << MOVE(,4,FILNAM1+LEN,LSB);LEN+4=>LEN // move in /lsb >> (,0,LCMASK) REPEAT // convert to upper case loop << // converts all alphas in line IF FILNAM1[] GT HEX'60' AND LT HEX'7B' THEN & RY =>FILNAM1[] (,+1) >> UNTIL (,RX EQ LEN) RETURN END //****************************************************************************** ROUTINE FAR_PRRA ADDVEC(,22,DMANERR) // write dm error ADDNUM(SAVERA) PUTVEC() RETURN END //****************************************************************************** ROUTINE FAR_IOERR // Report dman error to logfile & // to remote kermit CALL PRRA //write dm error MOVE(,21,DATABUF,DMANERR) //copy dman message (without final space) // to buf ERROR(,21) //send it as error packet RETURN END //****************************************************************************** ROUTINE RTYPECHECK // Rfile filetype checking TEST & DMERRMASK NE THEN << // if connect failed CALL PRRA // write dm error MOVE(,15,DATABUF,CREFAIL) // copy fail message to buf MOVE(,LEN,DATABUF+15,FILNAM1) // add the file name. ERROR(,LEN+15) // send it as a error pak RETURN('A') // abort >> ELSE << IF SAVERA & FTYPELS LRSH 16 NE 1 THEN // check if log sequential << MOVE(,27,DATABUF,CRETYPE) // if not complain MOVE(,LEN,DATABUF+27,FILNAM1) ERROR(,LEN+27) PUT(LOGSTREAM,45,DMESS16) RETURN('A') >> TEST BINFILE EQ THEN // if textfile check matches << IF SAVERA & FTYPETB EQ THEN // any existing filetype << MOVE(,27,DATABUF,CRETEXT) // if not complain MOVE(,LEN,DATABUF+27,FILNAM1) ERROR(,LEN+27) PUT(LOGSTREAM,45,DMESS16) RETURN('A') >> OPEN(FILESTREAM,TXOUT_ERR,ERROPT) // open a text file >> ELSE << IF SAVERA & FTYPETB NE THEN // if binary file check << // against any existing MOVE(,29,DATABUF,CREBIN) // file and complain if MOVE(,LEN,DATABUF+29,FILNAM1) // non matching ERROR(,LEN+29) PUT(LOGSTREAM,45,DMESS16) RETURN('A') >> OPEN(FILESTREAM,BINOUT_ERR,ERROPT) // else open a binary file >> >> RETURN END //****************************************************************************** ROUTINE FAR_FILE_DE_PREFIX // deprefix file paks 0=>J UNTIL(,J EQ LEN) DO // de_prefix it << CALL DE_PREFIX (,RCOUNT=>I) // set I for repeat count WHILE (, GT 1) DO // loop if repeating << DATABUF[J]=>BUFFER[IB] // put last char in again (,+1=>IB) (,I-1=>I) // and repeat loop >> (,1=>RCOUNT) // reset (,J+1=>J) // next char >> IB=>LEN RETURN END //****************************************************************************** ROUTINE FAR_RFILE // rx file header IF NUMTRY GT MAXTRY THEN RETURN('A') // abort if too many tries +1=>NUMTRY RPACK() // get a packet TEST EQ 'S' THEN // sendinit, ie our ack lost << // if so send again IF OLDTRY GT MAXTRY THEN RETURN('A') // too many retries? +1=>OLDTRY TEST N EQ THEN 63 // if not out of sequence mod 64 ELSE -1 // with out packet number TEST EQ NUM THEN // then send our inits again << N=>NEXTN;NUM=>N SPAR() 'Y'=>TYPE;9=>LEN;SPACK();NEXTN=>N 0=>NUMTRY // reset counter RETURN(STATE) // same state >> ELSE << RETURN('A') // otherwise abort >> >> ELSE << TEST EQ 'Z' THEN // could be eof << IF OLDTRY GT MAXTRY THEN RETURN('A') // if too many tries abort +1=>OLDTRY TEST N EQ THEN 63 // if not out of sequence mod 64 ELSE -1 // with out packet number TEST EQ NUM THEN // ok so ack it << N=>NEXTN;NUM=>N 'Y'=>TYPE;0=>LEN;SPACK();NEXTN=>N 0=>NUMTRY RETURN(STATE) >> ELSE << RETURN('A') // no so abort >> >> ELSE << TEST EQ 'F' THEN // file header, this is << // what we want IF NUM NE N THEN RETURN('A') // correct packet number? CALL FILE_DE_PREFIX // de prefix the f pak IF NPARMS EQ OR SERVER NE THEN // if no filename parm << // or if so but is server MOVE(,LEN,DATABUF,BUFFER) (,0,0) // hash to valid name // whatever is in databuf HASHFILE() >> IF NPARMS NE AND SERVER EQ THEN // if not server and a file << // name was given MOVE(,LF=>LEN,FILNAM1,FILNAM) /!RAL// MOVE(,4,FILNAM1+LEN,ATTRIBUTE) // concatenate /add /!RAL// LEN+4=>LEN /!GEC/! MOVE(,15,FILNAM1+LEN,ATTRIBUTE) // /NEW/Z(1,1,127) /!GEC/! LEN+15=>LEN IF BINFILE NE THEN << MOVE(,4,FILNAM1+LEN,LSB);LEN+4=>LEN // move in /lsb >> >> ADDVEC(,IB,BUFFER) // then this to be used ADDVEC(,14,RXMESS) ADDVEC(,LEN,FILNAM1) // show what name received PUTVEC() // as. 0=>IB /!GEC/! DMCONNECT(FILESTREAM,0,0) DMCONNECT(FILESTREAM,LEN,FILNAM1) =>SAVERA CALL RTYPECHECK // check filetypes etc IF EQ 'A' THEN RETURN(RA) // if abort return 'Y'=>TYPE;0=>LEN;SPACK() // ack it NUMTRY=>OLDTRY 0=>NUMTRY N+1/64;RB=>N // next packet number RETURN('D') // return for data >> ELSE << TEST EQ 'B' THEN // break transmission eot << IF NUM NE N THEN RETURN('A') // check packet number 'Y'=>TYPE;0=>LEN=>LISTEN;SPACK() // ack ok RETURN('C') // return complete >> ELSE << TEST EQ 'E' THEN // if error packet << PRERRPKT() // print it RETURN('A') >> ELSE << TEST EQ 0 THEN // if checksum error << 'N'=>TYPE;0=>LEN;SPACK() // nak it RETURN(STATE) // retry >> ELSE << RETURN('A') // anything else, abort >> >> >> >> >> >> RETURN END //****************************************************************************** ROUTINE RDATA // rx data IF NUMTRY GT MAXTRY THEN RETURN('A') // abort if too many tries +1=>NUMTRY RPACK() // get a packet TEST EQ 'D' THEN // data packet? << IF NUM NE N THEN // new packet? << IF OLDTRY GT MAXTRY THEN RETURN('A') // too many retries? +1=>OLDTRY TEST N EQ THEN 63 // if not out of sequence mod 64 ELSE -1 // with out packet number TEST EQ NUM THEN // in sequence so << N=>NEXTN;NUM=>N 'Y'=>TYPE;0=>LEN;SPACK();NEXTN=>N // ack it 0=>NUMTRY // reset counter RETURN(STATE) // same state >> ELSE // not in seq << RETURN('A') // so abort >> >> BUFEMP() // write to file IF RA EQ 'A' THEN RETURN(RA) // pass on any errors. 'Y'=>TYPE;0=>LEN;SPACK() // ack it NUMTRY=>OLDTRY 0=>NUMTRY N+1/64;RB=>N RETURN('D') // return for data >> ELSE << TEST EQ 'F' THEN // if file packet << IF OLDTRY GT MAXTRY THEN RETURN('A') // if too many tries abort +1=>OLDTRY TEST N EQ THEN 63 // if not out of sequence mod 64 ELSE -1 // with out packet number then TEST EQ NUM THEN // ack it << N=>NEXTN;NUM=>N 'Y'=>TYPE;0=>LEN;SPACK();NEXTN=>N 0=>NUMTRY RETURN(STATE) >> ELSE << RETURN('A') // no so abort >> >> ELSE << TEST EQ 'Z' THEN // is it eof << IF NUM NE N THEN RETURN('A') // correct packet number? 'Y'=>TYPE;0=>LEN;SPACK() IF IB NE THEN << PUT(FILESTREAM,IB,0=>IB+BUFFER) //make sure buffer emptied IF RA LT //0// THEN << =>SAVERA IOERR() // report dman error RETURN('A') >> >> CLOSE(FILESTREAM,0) // ack and close file 0=>NPARMS // in case other end sends >1 file. N+1/64;RB=>N RETURN('F') // return for next file >> ELSE << TEST EQ 'E' THEN // if error packet << PRERRPKT() // print it RETURN('A') >> ELSE << TEST EQ 0 THEN // if checksum error << 'N'=>TYPE;0=>LEN;SPACK() // nak it RETURN(STATE) // retry >> ELSE << RETURN('A') // anything else, abort >> >> >> >> >> RETURN END //****************************************************************************** ROUTINE FAR_DE_PREFIX // copy to BUFFER decoding on the // way. IF RPEAT NE ' ' AND DATABUF[J] EQ RPEAT THEN << DATABUF[+1=>J]-' '=>RCOUNT // if repeat then set count (,+1=>J) >> // if quoting deal with 8bit IF EIGHTQ NE 'N' AND DATABUF[J] EQ EIGHTQ THEN (1=>FLAG8,+1=>J) // remember flag IF DATABUF[J] EQ QUOTE THEN // control quote? << IF DATABUF[J+1=>J] NE QUOTE AND NE MY8BIT AND NE MYRPEAT THEN // if so and next char not << // a quote char (,,HEX'BF' & RA=>RA) // then controllify it IF EQ HEX '3F' THEN + 64 // if ? then make ff >> >> IF (,IMAGE NE OR RA NE HEX '0A' OR BINFILE NE) THEN << // only if image mode or binfile or not lf IF (,BINFILE NE AND FLAG8 NE )THEN (+128,,0=>FLAG8) // if binary wants 8th bit =>BUFFER[IB] // write char to file buffer (,+1=>IB) >> =>DATABUF[J] // Store here in case repeating RETURN END //****************************************************************************** ROUTINE BUFEMP // write data buffer to file 0=>J // init counter UNTIL (,J EQ LEN) DO // loop through data << CALL DE_PREFIX // De prefix to buffer (,RCOUNT=>I) // set I for repeat count WHILE (, GE 1) DO // loop incase repeating << // if text put when cr found TEST EQ HEX'0D' AND BINFILE EQ THEN << PUT(FILESTREAM,IB-1,0=>IB+BUFFER) IF RA LT //0// THEN << =>SAVERA IOERR() // report dman error RETURN('A') >> >> // if binary put every 235 ELSE IF IB GE 235 THEN << PUT(FILESTREAM,IB,0=>IB+BUFFER) // reset IB for next line IF RA LT //0// THEN << =>SAVERA IOERR() // report dman error RETURN('A') >> >> IF (,I GT 1) THEN // if repeating << DATABUF[J]=>BUFFER[IB] // put last char in again (,+1=>IB) >> (,I-1=>I) // and repeat loop >> (,1=>RCOUNT) (,J+1=>J) >> RETURN(1) // (1) just in case last chara. read was 'A' END //****************************************************************************** ROUTINE FAR_RECSW // state table switcher for rx files 0=>N=>NUMTRY=>IB // init packet number and no tries yet 'R'=>STATE // start state REPEAT // always loop << IF DEBUG NE THEN << STATE=>DMESS4[14] PUT(LOGSTREAM,15,DMESS4) >> TEST STATE EQ 'R' THEN << RINIT()=>STATE // receive init >> ELSE << TEST EQ 'F' THEN << RFILE()=>STATE // receive file >> ELSE << TEST EQ 'D' THEN << RDATA()=>STATE // receive data >> ELSE << TEST EQ 'C' THEN << RETURN(1) // completed state >> ELSE << CLOSE(FILESTREAM) // must be 'a' RETURN(0) // abort state >> >> >> >> >> ALWAYS END //****************************************************************************** ROUTINE FAR_SINIT // send initialise, send my parms get // locals parms IF NUMTRY GT MAXTRY THEN RETURN('A') // if too many tries give up +1=>NUMTRY SPAR() // fill up init info pak IF SERVER EQ THEN // if not server assume slow fingers << SEND(DELAY,1,0,TIMEVENT) // wait for delay before sending init WAIT(,,,TIMEVENT) >> 'S'=>TYPE;9=>LEN;SPACK() TEST RPACK() EQ 'N' THEN << RETURN(STATE) // send s packet and what response? >> ELSE // not nak so try if ack?? << TEST EQ 'Y' THEN << IF N NE NUM THEN RETURN(STATE) // if wrong ack stay in same state RPAR() // get her parms IF BINFILE NE AND EIGHTQ EQ 'N' THEN << // if binary file and quoting not agreed MOVE(,53,DATABUF,MESSYBIT) ERROR(,53) // abort with error pak and message RETURN('A') >> 0=>NUMTRY N+1/64;RB=>N RETURN(F_OR_X_FLAG) // return for file or text >> ELSE << TEST EQ 'E' THEN // deal with error packet << PRERRPKT () RETURN('A') >> ELSE << TEST EQ 0 THEN // checksum error? so retry << RETURN(STATE) >> ELSE << // must be unknown RETURN('A') // anything else, cant go on >> >> >> >> END //****************************************************************************** ROUTINE FAR_SFILE // send file or text header IF NUMTRY GT MAXTRY THEN RETURN('A') // if too many tries give up +1=>NUMTRY // next try IF FP EQ THEN // if not already open << IF DEBUG NE THEN << ADDVEC(,34,DMESS5) ADDVEC(,LF,FILNAM) PUTVEC() >> DMCONNECT(READSTREAM,LF,FILNAM) =>SAVERA IF & DMERRMASK NE THEN << // if connect fails then report CALL PRRA // write dm error MOVE(,17,DATABUF,READFAIL) MOVE(,LF,DATABUF+17,FILNAM) ERROR(,LF+17) RETURN('A') >> IF SAVERA & FTYPELS LRSH 16 NE 1 THEN // check if log sequential << MOVE(,27,DATABUF,CRETYPE) // if not complain MOVE(,LF,DATABUF+27,FILNAM) ERROR(,LF+27) PUT(LOGSTREAM,45,DMESS16) RETURN('A') >> TEST BINFILE EQ THEN // if textfile then check << // any existing file for type IF SAVERA & FTYPETB EQ THEN // lst << MOVE(,27,DATABUF,CRETEXT) // if not complain MOVE(,LF,DATABUF+27,FILNAM) ERROR(,LF+27) PUT(LOGSTREAM,45,DMESS16) RETURN('A') >> OPEN(READSTREAM,TXIN_ERR,ERROPT) // open file if text >> ELSE << IF SAVERA & FTYPETB NE THEN // otherwise check binary type << MOVE(,29,DATABUF,CREBIN) // if not complain MOVE(,LEN,DATABUF+29,FILNAM) ERROR(,LEN+29) PUT(LOGSTREAM,45,DMESS16) RETURN('A') >> OPEN(READSTREAM,BININ_ERR,ERROPT) // open file if binary >> 0=>EOFPENDING=>BINEOF // init flag 1=>FP // remember opened >> MOVE(,LF,FILNAM1,FILNAM) // move filename (,0) // init count FILNAM1=>NEWFILNAM // set to same in case no gec '.' LF=>LEN IF NORMAL NE THEN // if normal-form then truncate so << WHILE (,RX NE LF) DO // look for last level in cat structure << IF FILNAM1[] EQ '.' OR EQ '%' OR EQ '&'THEN << // catalogue separator found FILNAM1+RX+1=>NEWFILNAM // remember as the latest lowest?? LF-RX-1=>LEN // calculate length left(length of name?) >> (,+1) // carry on looking >> >> ADDVEC(,8,SENDMESS) ADDVEC(,LF,FILNAM) ADDVEC(,4,SENDMESS+7) // show what file is being sent as ADDVEC(,LEN,NEWFILNAM) PUTVEC() (,0=>I=>J) WHILE (,LT LEN) DO << NEWFILNAM[] EN_PREFIX() (,J+1=>J) >> I=>LEN F_OR_X_FLAG=>TYPE;MOVE(,LEN,DATABUF,BUFFER);SPACK() // send f or x packet TEST RPACK() EQ 'N' THEN // get reply << IF (NUM-1=>NUM LT 0) THEN 63=>NUM // if nak stay in this state IF N NE NUM THEN RETURN(STATE) // unless nak from next packet GOTO Y // which means ack for this >> // packet so fall through ELSE << TEST EQ 'Y' THEN << IF N NE NUM THEN RETURN (STATE) // if wrong ack stay in f state Y: 0=>NUMTRY // reset try counter N+1/64;RB=>N // bump packet count BUFILL()=>SIZE // get first data from file IF GE THEN RETURN('D') // return for data state IF +1 EQ THEN RETURN('Z') // check for eof(-1) RETURN('A') // return for io error >> ELSE << TEST EQ 'E' THEN << // deal with error packet PRERRPKT() RETURN('A') >> ELSE << TEST EQ 0 THEN // receive fail so stay state << RETURN(STATE) >> ELSE << RETURN('A') // else abort >> >> >> >> END //****************************************************************************** ROUTINE GETC // get next char from file // similar to nextc IF GP LT AND REREAD EQ THEN << 0=>EOFLAG // always set default assumption REPEAT << IF BINEOF EQ THEN // if not had eof in binfile << GET(READSTREAM,INBUFLEN,INBUF) => SAVERA // read new line (,=>RECLEN) >> IF RA LT 0 OR (,BINEOF NE) THEN TEST & EOFMASK EQ EOF OR BINEOF NE THEN // if had eof << 1 =>EOFLAG // set end of file -2=>GP RETURN(0) >> ELSE << // dman error IOERR() // error already in SAVERA RETURN(0-2) >> >> UNTIL BINFILE EQ OR RECLEN NE // until non null record if binary IF BINFILE EQ THEN // if text then add return << CR=>INBUF[RECLEN] (,+1=>RECLEN) >> 0=>GP // pointer to start >> INBUF[GP] // get the next char IF (,IMAGE EQ AND BINFILE EQ) THEN & MASK // if not image mode mask bit 8 (,GP+1=>GP) IF (,GE RECLEN) THEN (,0=>REREAD-1=>GP) // if end of record reset RETURN(RA) END //****************************************************************************** // This area is very hacked to get repeat counting to work in binfiles ROUTINE EN_PREFIX // char in RA to BUFFER with prefixing IF (,RA NE CR AND RPEAT NE ' ' AND STATE NE 'S') THEN // if repeat agreed << =>SAVE // this is the repeat count prefix bit WHILE GETC() EQ SAVE AND EOFLAG EQ AND RCOUNT LT 94 DO RCOUNT+1=>RCOUNT // if next char same count it IF EOFLAG NE AND BINFILE NE THEN 0=>RECLEN+1=>GP // Fix reclen if binary eof GP-1=>GP // either way reset GETC IF LT AND REREAD EQ THEN RECLEN-1=>GP // cater for last on line in GETC IF RCOUNT GT 1 THEN // if more than 1 << TEST LT 4 THEN // then if too few dont do << (,GP-RA+1=>GP-GP) // Reset GETC and set rx zero IF GP LT THEN // Carry down to PREBUF (only happens << // if binary) REPEAT SAVE=>INBUF[-1] // Put the SAVE char in, rcount times-1 UNTIL (, EQ GP) 1=>REREAD // set flag to tell GETC IF EOFLAG NE THEN << 0=>EOFLAG=>RECLEN+1=>BINEOF // if endof file put it off till // done >> // the carry over. >> >> ELSE << MYRPEAT=>BUFFER[I];(,+1=>I) // insert repeat count prefix RCOUNT+' '=>BUFFER[I];(,+1=>I) // insert count chared >> 1=>RCOUNT >> SAVE // and restore RA then continue as norm >> IF (,EIGHTQ NE 'N' AND RA GT 127) THEN // if quoting and 8 bit set << // then put in 8bit quote (,,RA) MY8BIT=>BUFFER[I];(,+1=>I) (RY & 127) // now loose top bit >> IF LT ' ' OR EQ HEX'7F' OR EQ MYQUOTE OR EQ MY8BIT OR EQ MYRPEAT THEN // is control handling needed? << IF(,RA NE MY8BIT OR EIGHTQ NE 'N') THEN << IF (,RA NE MYRPEAT OR RPEAT NE ' ')THEN << IF EQ 13 AND (,IMAGE EQ) AND (,BINFILE EQ) THEN // if cr and not image mode do << MYQUOTE=>BUFFER[I];(,+1=>I) // quote it (13,64 XOR RA);RX=>BUFFER[I];(,+1=>I) 10 // next send lf >> (,,RA) MYQUOTE=>BUFFER[I];(,+1=>I) // put control quote in (RY) IF NE MYQUOTE AND NE MY8BIT AND NE MYRPEAT THEN // if not a quote char << (,64 XOR RY=>RA) // uncontrolify >> >> >> >> TEST (,IMAGE NE) THEN // deposit the char << =>BUFFER[I];(,+1=>I) >> ELSE << =>BUFFER[I];(,+1=>I) // same for now >> RETURN END //****************************************************************************** ROUTINE FAR_BUFILL // get bufferfull of data // with control quoting only 0=>I IF EOFPENDING EQ THEN << WHILE GETC() GE 0 AND (,EOFLAG EQ ) DO // for not eof (getc always // positive) << CALL EN_PREFIX // do any prefixing to buffer IF SPSIZ-7 LE I THEN RETURN(I) // check buffer full?? // Allow 4 for 5 more chars possible after I=spsiz-8. And 3 for Mark,Len and // Check. >> IF //GETC// LT 0 THEN // reset C reg RETURN(RA) // -2 flags dman error >> IF I EQ THEN RETURN(0-1) // must be eof so set -1 1=>EOFPENDING // remember on next entry RETURN(I) // that eof was found END //****************************************************************************** ROUTINE FAR_SDATA // send file data IF NUMTRY GT MAXTRY THEN RETURN('A') // if too many tries give up +1=>NUMTRY 'D'=>TYPE;SIZE=>LEN;MOVE(,LEN,DATABUF,BUFFER);SPACK() // send d packet RPACK() TEST EQ 'N' THEN << IF (NUM-1=>NUM LT 0) THEN 63=>NUM // if nak stay in this state IF N NE NUM THEN RETURN(STATE) // unless nak from next packet GOTO Z // which means ack for this >> // packet so fall through ELSE << TEST EQ 'Y' THEN << IF N NE NUM THEN RETURN (STATE) // if wrong ack stay in f state Z: 0=>NUMTRY // reset try counter N+1/64;RB=>N // bump packet count BUFILL()=>SIZE // get data from file IF GE THEN RETURN('D') // remain in data state IF +1 EQ THEN RETURN('Z') // if end of file return so RETURN('A') // return for io error >> ELSE << TEST EQ 'E' THEN << // deal with error packet PRERRPKT() RETURN('A') >> ELSE << TEST EQ 0 THEN // receive fail so stay state << RETURN(STATE) >> ELSE << RETURN('A') // else abort >> >> >> >> END //****************************************************************************** ROUTINE FAR_SEOF // send end-of-file IF NUMTRY GT MAXTRY THEN RETURN('A') // if too many tries give up +1=>NUMTRY 'Z'=>TYPE;SPACK() // send z packet RPACK() TEST EQ 'N' THEN << IF (NUM-1=>NUM LT 0) THEN 63=>NUM // if nak stay in this state IF N NE NUM THEN RETURN(STATE) // unless nak from next packet GOTO Z2 // which means ack for this >> // packet so fall through ELSE << TEST EQ 'Y' THEN << IF N NE NUM THEN RETURN (STATE) // if wrong ack stay in f state Z2: 0=>NUMTRY // reset try counter N+1/64;RB=>N // bump packet count IF DEBUG NE THEN << ADDVEC(,19,DMESS6) ADDVEC(,LF,FILNAM) PUTVEC() >> CLOSE(READSTREAM) // close currently read file 0=>FP // reset no file open IF DEBUG NE THEN PUT(LOGSTREAM,26,DMESS7) // say getting next file IF GNXTFL() EQ THEN RETURN('B') // if there isnt one then break IF DEBUG NE THEN // file got << ADDVEC(,12,DMESS8) ADDVEC(,LF,FILNAM) PUTVEC() >> RETURN('F') // return for more files >> ELSE << TEST EQ 'E' THEN << // deal with error packet PRERRPKT() RETURN('A') >> ELSE << TEST EQ 0 THEN // receive fail so stay state << RETURN(STATE) >> ELSE << RETURN('A') // else abort >> >> >> >> END //****************************************************************************** ROUTINE SBREAK // send break IF NUMTRY GT MAXTRY THEN RETURN('A') // if too many tries give up +1=>NUMTRY 'B'=>TYPE;SPACK() // send b packet RPACK() TEST EQ 'N' THEN << IF (NUM-1=>NUM LT 0) THEN 63=>NUM // if nak stay in this state IF N NE NUM THEN RETURN(STATE) // unless nak from next packet GOTO Z3 // which means ack for this >> // packet so fall through ELSE << TEST EQ 'Y' THEN << IF N NE NUM THEN RETURN (STATE) // if wrong ack stay in f state Z3: 0=>NUMTRY // reset try counter N+1/64;RB=>N // bump packet count RETURN('C') >> ELSE << TEST EQ 'E' THEN << // deal with error packet PRERRPKT() RETURN('A') >> ELSE << TEST EQ 0 THEN // receive fail so stay state << RETURN(STATE) >> ELSE << RETURN('A') // else abort >> >> >> >> END //****************************************************************************** ROUTINE FAR_GNXTFL // returns next filename parameter from filelist TEST IP LT NPARMS THEN // if more to come << IF IP EQ THEN MOVE(,80,FILELIST,BUF) // if first time in then move // filelist in MARKS[IP*2+2]-MARKS[IP*2+1]=>LF // get length of filename MARKS[IP*2+1]=>P // set pointer to it MOVE (,LF,FILNAM,FILELIST+P) // shift it IP+1=>IP // inc for next time >> ELSE << 0=> IP;RETURN(//0//) >> RETURN(1) END //****************************************************************************** ROUTINE FAR_SENDSW // state table switcher for tx files or text 0=>N=>NUMTRY=>REREAD-1=>GP // init packet number and no tries yet 'S'=>STATE // start state REPEAT // always loop << IF DEBUG NE THEN << STATE=>DMESS10[15] PUT(LOGSTREAM,16,DMESS10) >> TEST STATE EQ 'S' THEN << SINIT()=>STATE // send init >> ELSE << TEST EQ 'F' OR EQ 'X' THEN << SFILE()=>STATE // send filename >> ELSE << TEST EQ 'D' THEN << SDATA()=>STATE // send data >> ELSE << TEST EQ 'Z' THEN << SEOF()=>STATE // send eof >> ELSE << TEST EQ 'B' THEN << SBREAK()=>STATE // send break >> ELSE << TEST EQ 'C' THEN << RETURN(1) // completed state >> ELSE << CLOSE(READSTREAM) // must be 'a' RETURN(0) // abort state >> >> >> >> >> >> >> ALWAYS END //****************************************************************************** ROUTINE FAR_DEBRIEF // After a transfer report // or handle matters arising TEST TIMING EQ 1 THEN // if timeout was reason for << // returning here then PUT(INSTREAM,38,MESSTIME) // write to other kermit user PUT(INSTREAM,2,CRLF) // still in physical mode. PUT(LOGSTREAM,38,MESSTIME) 0=>TIMING >> ELSE << IF NUMTRY GT MAXTRY OR OLDTRY GT MAXTRY THEN << // else if retries exceeded PUT(INSTREAM,34,MESSTRY) // anyway then say so before PUT(INSTREAM,2,CRLF) // aborting. PUT(LOGSTREAM,34,MESSTRY) >> >> RETURN END //****************************************************************************** ROUTINE FAR_FILE_PARSER // Parses the file list WHILE (,PP LT LEN) DO // search rest of line << (,+1) // inc rx(parser pointer) WHILE BUF[] EQ ' ' AND RX LT LEN DO (,+1) // ignore extra spaces TEST RX NE LEN THEN // dont do this if eol << (RX=>MARKS[I]=>RY,+1=>I) // save pointer to parm in next loc (,RY) // retreive rx WHILE BUF[] NE ' ' AND RX LT LEN DO (,+1) // find end of parm // now rx points to space after parm (RX=>MARKS[I]=>PP,+1=>I) // save position in next loc >> ELSE // eol so arrange while loop << // to end. LEN=>PP >> >> I-1 SEXT /2=>NPARMS // remember number of parms RETURN END //****************************************************************************** ROUTINE FAR_SERVER_CONTROL // this is the server cycle PUT(OUTSTREAM,58,SIGNON) //tell oper to go away CLOSE(INSTREAM) OPEN(INSTREAM,HEX'88') //Physical update mode CONTROL(INSTREAM,1,STOP_ON_CR) //terminates get on C.R. CONTROL(INSTREAM,1,EVEN) //Turn on checking 0=>N=>NUMTRY // server packets always zero TIMEOUT=>SAVE_TIMEOUT // change timeout on server SERVER_TIMEOUT=>TIMEOUT // idle to 30 sec CONTROL(INSTREAM,TIMEOUT,PGTCODE) //declare new timout for put-gets REPEAT // start server loop << TEST RPACK() EQ 'S' THEN // if S then receive sent files << SAVE_TIMEOUT=>TIMEOUT // restore timeout CONTROL(INSTREAM,TIMEOUT,PGTCODE) //declare new timout for put-gets TEST RECSW() EQ THEN PUT(LOGSTREAM,14,DMESS13) // Do receive command ELSE PUT(LOGSTREAM,5,DMESS14) CALL DEBRIEF // tidy up after 0=>N=>NUMTRY TIMEOUT=>SAVE_TIMEOUT // re-extend timeout SERVER_TIMEOUT=>TIMEOUT CONTROL(INSTREAM,TIMEOUT,PGTCODE) //declare new timout for put-gets >> ELSE << TEST EQ 'R' THEN // if R or X then send the required // files << FAR_SEND_F_OR_X('F') // set up for file sending >> ELSE TEST EQ 'G' AND (,LEN NE 0) THEN // if generic command with data << TEST DATABUF[0] EQ 'F' OR EQ 'L' THEN // then if Finish Quit << TEST EQ 'F' THEN << 'Y'=>TYPE;0=>LEN=>LISTEN;SPACK() // ack it first >> ELSE << MOVE(,47,DATABUF,BYEMESS) // say cannot logout (L) ERROR(,47) PUT(LOGSTREAM,0,0) CLOSEDOWN(1) STOP(0) >> SAVE_TIMEOUT=>TIMEOUT // restore timeout CLOSE(INSTREAM) OPEN(INSTREAM,TEXTIN) // back to logical CONTROL(INSTREAM,,DEFAULT) // reset all CONTROL(INSTREAM,'C' ALSH 8 +8,ALTCHAR) // restore backspace RETURN >> ELSE TEST EQ 'T' THEN // type a file << //DATABUF[1]-' '=>LEN// LEN-2=>LEN MOVE(,RA NEG,DATABUF+RA-1,RY+2) FAR_SEND_F_OR_X('X') // set up for text sending >> ELSE << // otherwise invalid command MOVE(,28,DATABUF,NOTSERV) ERROR(,28) 0=>N >> >> ELSE << TEST EQ 'I' THEN // if I then do receive init << RPAR() // get parms TEST BINFILE NE AND EIGHTQ EQ 'N' THEN << // if binary file and quoting not agreed MOVE(,53,DATABUF,MESSYBIT) ERROR(,53) >> ELSE << SPAR() 'Y'=>TYPE;9=>LEN;SPACK() // ack with my parms >> 0=>N >> //ELSE TEST EQ 'C' THEN// //host command// //<>// ELSE TEST EQ 0 THEN // if invalid packet send Nak << 'N'=>TYPE;N=>NUM;0=>LEN SPACK() 0=>N >> ELSE << MOVE(,28,DATABUF,NOTSERV) // if anything else assume non- ERROR(,28) // implemented server command 0=>N >> >> >> >> ALWAYS END //****************************************************************************** ROUTINE FAR_SEND_F_OR_X(F_OR_X_FLAG) // sends File or teXt (setting flag) CALL FILE_DE_PREFIX // deprefix the f pak MOVE(0-1=>PP,LEN,BUF,0=>IB+BUFFER) // copy to buf etc TRANSLATE(,LEN,BUF,TABLE) // convert to upper case 1=>I CALL FILE_PARSER // get file names IF NE THEN // if files present << 0=>IP CALL GNXTFL // get first file name >> 0=>FP SAVE_TIMEOUT=>TIMEOUT // restore timer CONTROL(INSTREAM,TIMEOUT,PGTCODE) //declare new timout for put-gets TEST SENDSW() EQ THEN PUT(LOGSTREAM,11,DMESS15) // do send command ELSE PUT(LOGSTREAM,5,DMESS14) CALL DEBRIEF 0=>N=>NUMTRY // tidy up after TIMEOUT=>SAVE_TIMEOUT // re-extend timeout SERVER_TIMEOUT=>TIMEOUT CONTROL(INSTREAM,TIMEOUT,PGTCODE) //declare new timout for put-gets RETURN END //****************************************************************************** ROUTINE FAR_HELPER(,,HELP) // writes out a vector paragraph // does a cr on ~ and ends on $ (,0=>OFS) // ry contains address of help vector REPEAT << WHILE HELP[] NE '$' AND NE '~' DO (,RX+1) // look for either special char PUT(OUTSTREAM,RX-OFS,HELP+OFS) // in either case write line (HELP[+OFS],+1=>OFS) // offset address to next line >> UNTIL EQ '$' // continue until end found RETURN END //****************************************************************************** ROUTINE FAR_SHOWER // show command PUT(OUTSTREAM,76,TITLE+1) PUT(OUTSTREAM,76,SHOWVEC) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+76) YNPRINT(DEBUG) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+151) SPRINT(EOL) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+176) SPRINT(STX) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+201) SPRINT(PAD) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+226) SPRINT(PADCAR) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+251) SPRINT(DELAY/MILLI) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+176) SPRINT(MAXTRY) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+201) SPRINT(MYTIME) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+226) SPRINT(TIMEOUT) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+251) SPRINT(MYQUOTE) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+100+176) SPRINT(MY8BIT) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+100+201) YNPRINT(BINFILE) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+100+226) SPRINT(MYRPEAT) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,25,SHOWVEC+100+125+226) YNPRINT(NORMAL) RETURN END //****************************************************************************** ROUTINE YNPRINT(SAVE) CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,4,HELP3+2) TEST SAVE EQ THEN PUT(OUTSTREAM,3,OFF) ELSE PUT(OUTSTREAM,2,OFF+3) RETURN(SAVE) END //****************************************************************************** ROUTINE SPRINT(SAVE) // prints ra as a 6 char int TOCHAR(,6,DBUF) PUT(OUTSTREAM,6,DBUF) RETURN(SAVE) END //****************************************************************************** ROUTINE TOGGLE(SAVE) // this sets parameter on or off(1 or 0) by word TEST COMPARE(,LEN,BUF+PP,OFF) EQ THEN 0 //word is "off" ELSE TEST COMPARE(,LEN,BUF+PP,OFF+3) EQ THEN 1 //word is "on" ELSE << PUT(OUTSTREAM,17,INVPARM) RETURN(SAVE) >> RETURN END //****************************************************************************** ROUTINE FAR_PARSER // command parser PUT(OUTSTREAM,0,0) // make sure on new line REPEAT // loop until commanded << IF TAKE_FILE EQ THEN // if no take file << CONTROL(OUTSTREAM,,NOCRLF) PUT(OUTSTREAM,11,PROMPT) // output prompt >> TEST TAKE_FILE EQ THEN // if no take file << GET(INSTREAM,80,BUF) >> ELSE << GET(WITHSTREAM,80,BUF) // otherwise read file IF & EOFMASK EQ EOF THEN << RETURN // if eof return >> >> PUT(LOGSTREAM,,) // echo to log file (,=>LEN-RX,LCMASK) // save length and set rx =0 REPEAT // convert to upper case loop << // converts all alphas in line IF BUF[] GT HEX'60' AND LT HEX'7B' THEN & RY =>BUF[] (,+1) >> UNTIL (,RX GE LEN) (,0) WHILE (BUF[] EQ ' ' AND RX LT LEN) DO (,+1) // ignore leading spaces (,RX=>J) // save start of command WHILE (BUF[] NE ' ' AND RX LT LEN) DO (,+1) // search line for space // now rx points to space at end of command(or past last space if no command) (,=>PP) // save position IF (,RX EQ OR PP EQ J) THEN GOTO FAR_MISS // if not null command then << (0=>I) // init counter WHILE I LE COMSIZ AND COMPARE(,PP-J,BUF+J, COMMANDS+I) NE DO (I+1=>I) // either command list exhausted and no such command or command found TEST (I GT COMSIZ ) THEN << // if no such command found PUT(OUTSTREAM,15,COMMESS) // then error >> ELSE << // command valid I=>MARKS[0] // save command value (,+1=>I) // init for first parm CALL FILE_PARSER // extract file names MARKS[0] // otherwise goto command GOTO WHATCOM[RA] SE: TEST NPARMS NE THEN // if send command (0) << // and there was a parameter given 0=>IP // init gnxtfl first time CALL GNXTFL // get first file name 1=>SFLG // set kermit style sendflag RETURN // return for sending >> // otherwise filelist will default ELSE << 1=>SFLG RETURN //defaulted to %c >> EX: //quit or exit PUT(LOGSTREAM,0,0) CLOSEDOWN(0) STOP(0) RE: // receive command TEST NPARMS GT 1 THEN PUT(OUTSTREAM,17,TOOMESS) ELSE << IF NPARMS EQ 1 THEN // if a parameter then use it << 0=>IP CALL GNXTFL >> 1=>RFLG // set kermit flag for rx RETURN // return for receiving >> ST: // set command TEST NPARMS GT 9 THEN PUT(OUTSTREAM,17,TOOMESS) // max 9 parms ELSE << 0=>I NODDYWHILE: WHILE I LT NPARMS DO // silly way to get over disp error << GOTO LOOP // do loop >> GOTO ENDLOOP // miss loop LOOP: MARKS[I*2+2]-MARKS[I*2+1]=>LEN // locate next parm MARKS[I*2+1]=>PP 0=>J // find what parameter it was WHILE J LE PARMSIZ AND COMPARE(,LEN,BUF+PP, PARAMS+J)NE DO (J+1=>J) // check not too many TEST J GT PARMSIZ THEN PUT(OUTSTREAM,17,INVPARM) ELSE << I+1=>I // now find its value parameter TEST I GE NPARMS THEN << PUT(OUTSTREAM,17,INVPARM) PUT(OUTSTREAM,LEN,BUF+PP) >> ELSE << MARKS[I*2+2]-MARKS[I*2+1]=>LEN MARKS[I*2+1]=>PP FROMCHAR(,LEN,BUF+PP) // unchar it // now search to find what command TEST (,J EQ 3) THEN TOGGLE(DEBUG)=>DEBUG ELSE << TEST (, J EQ 12) THEN TOGGLE(REMOTE)=>REMOTE ELSE << TEST (, J EQ 18) THEN TOGGLE(IMAGE)=>IMAGE ELSE << TEST (,J EQ 0) THEN =>EOL ELSE << TEST (,J EQ 23) THEN =>STX ELSE << TEST (,J EQ 26) THEN =>PAD ELSE << TEST (,J EQ 29) THEN =>PADCAR ELSE << TEST(,J EQ 33) THEN << // check valid delay *MILLI=>DELAY IF LT THEN << PUT(OUTSTREAM,22,RANGEMESS) // if not say so 0=>DELAY // and set smallest >> >> ELSE << TEST(,J EQ 37) THEN << // check valid number =>MAXTRY IF GT 50 OR LT 0 THEN // if not say so << PUT(OUTSTREAM,22,RANGEMESS) 0=>MAXTRY >> >> ELSE << TEST(,J EQ 8) THEN << // same for these too =>MYTIME IF LT 1 THEN << PUT(OUTSTREAM,22,RANGEMESS) 1=>MYTIME >> >> ELSE << TEST(,J EQ 48) THEN << =>TIMEOUT // now in secs IF LT 1 THEN << PUT(OUTSTREAM,22,RANGEMESS) 1=>TIMEOUT >> >> ELSE << TEST(,J EQ 43) THEN=>MYQUOTE ELSE << TEST(,J EQ 55) THEN=>MY8BIT ELSE << TEST(, J EQ 59) THEN TOGGLE(BINFILE)=>BINFILE ELSE << TEST(,J EQ 65) THEN=>MYRPEAT ELSE << TEST(, J EQ 71) THEN TOGGLE(NORMAL)=>NORMAL ELSE << TEST(,J EQ 77) THEN=>RPSIZ ELSE << PUT(OUTSTREAM,17,INVPARM) >> >> >> >> >> >> >> >> >> >> >> >> >> >> >> >> >> >> >> I+1=>I GOTO NODDYWHILE // repeat the while ENDLOOP: // come here when while fails >> GOTO MISS SH: // show command TEST NPARMS GT THEN PUT(OUTSTREAM,17,TOOMESS) ELSE << CALL SHOWER >> GOTO MISS SV: // server mode 1=>SERVER CALL SERVER_CONTROL 0=>SERVER GOTO MISS HP: // help command TEST NPARMS GT 7 THEN PUT(OUTSTREAM,17,TOOMESS) ELSE << 0=>I WHILE I LT NPARMS DO << MARKS[I*2+2]-MARKS[I*2+1]=>LEN MARKS[I*2+1]=>PP 0=>J WHILE J LE COMSIZ AND COMPARE(,LEN,BUF+PP, COMMANDS+J)NE DO (J+1=>J) TEST J GT COMSIZ THEN PUT(OUTSTREAM,14,NOHELP) ELSE << GOTO HELPARMS[J] HSE: HELPER(,,HELP1) ;GOTO AIDED HRE: HELPER(,,HELP2) ;GOTO AIDED HST: HELPER(,,HELP3) ;GOTO AIDED HSH: HELPER(,,HELP4) ;GOTO AIDED HHP: HELPER(,,HELP5) ;GOTO AIDED HQU: HELPER(,,HELP6) ;GOTO AIDED HSV: HELPER(,,HELP7) ;GOTO AIDED EH: PUT(OUTSTREAM,14,NOHELP) AIDED: >> // help done I+1=>I >> IF NPARMS EQ THEN HELPER(,,TITLE) >> GOTO MISS E: PUT(OUTSTREAM,15,COMMESS) // error, no such command >> >> MISS: >> ALWAYS END //****************************************************************************** ROUTINE DO_THE_WORK IF (CFLG+RFLG+SFLG-1 NE ) THEN << CLOSEDOWN(0) STOP(0) >> CLOSE(INSTREAM) OPEN(INSTREAM,HEX'88') // physical update mode CONTROL(INSTREAM,1,STOP_ON_CR) // terminate gets on cr CONTROL(INSTREAM,1,EVEN) // check and strip even parity CONTROL(INSTREAM,TIMEOUT,PGTCODE) //timeout for put-gets IF DEBUG NE THEN << IF SFLG NE THEN PUT(LOGSTREAM,12,DMESS11) IF RFLG NE THEN PUT(LOGSTREAM,15,DMESS12) >> TEST RFLG NE THEN // receive command << TEST RECSW() EQ THEN PUT(LOGSTREAM,14,DMESS13) // DO RECEIVE COMMAND ELSE PUT(LOGSTREAM,5,DMESS14) >> ELSE << IF SFLG NE THEN // send command << 0=>FP // set file open switch to 'closed' 'F' => F_OR_X_FLAG // set File or teXt to File TEST SENDSW() EQ THEN PUT(LOGSTREAM,11,DMESS15) // do send command ELSE PUT(LOGSTREAM,5,DMESS14) >> >> DEBRIEF() CLOSE(INSTREAM) OPEN(INSTREAM,TEXTIN) // back to logical CONTROL(INSTREAM,,DEFAULT) // reset all CONTROL(INSTREAM,'C' ALSH 8 +8,ALTCHAR) // restore backspace RETURN END //****************************************************************************** ENTRYPOINT: OPEN(INSTREAM,//HEXPRINT +//TEXTIN) /!GEC/!CONTROL(INSTREAM,5,CONLT) // no case conversion OPEN(OUTSTREAM,TEXTOUT) DMCONNECT(LOGSTREAM,23,LOGVEC) OPEN(LOGSTREAM,TEXTOUT) GETSTREAMARG(WITHSTREAM,80,BUF) // look to see if WITH given COMPARE(,4,BUF,SINK) // compare WITH arg with SINK IF NE THEN // if Not SINK then read file << // Note-def proforma gives SINK 0=>SFLG=>RFLG OPEN(WITHSTREAM,TEXTIN) 1=>TAKE_FILE PUT(LOGSTREAM,32,TAKING) // inform user of taking from PUT(OUTSTREAM,32,TAKING) // file CALL PARSER // Parse commands therein CALL DO_THE_WORK // see if rx or tx to do PUT(LOGSTREAM,19,TAKEN) // inform user take is finished PUT(OUTSTREAM,19,TAKEN) 0=>TAKE_FILE CLOSE(WITHSTREAM) >> // now continue as normal REPEAT << 0=>SFLG=>RFLG PUT(OUTSTREAM,76,TITLE+1) PUT(OUTSTREAM,76,TITLE+78) CALL PARSER // find and execute commands etc CALL DO_THE_WORK // see if rx or tx to do >> ALWAYS END //******************************************************************************