home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
gec4000.zip
/
gecker.sou
next >
Wrap
Text File
|
1989-06-08
|
120KB
|
2,917 lines
// 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 <filename>, 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//
//<<//
// here go the bits to implement host commands
// these will be DL specific as GEC COMM cannot 'fork'
// another command.
// something like fork 'output %m'
// fork 'command (proforma must specify AIDA shell)'
// send %m with 'X' header to type file on terminal
//>>//
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
//******************************************************************************