PROGRAM kermit; {$NO GLOBALS} { Copyright (C) 1986, Trustees of Columbia University in the City of New York. Permission is granted to any individual or institution to copy or use this program except for explicitly commercial purposes, provided this copyright notice is retained. The Kermit file transfer protocol was developed at Columbia University. It is named after Kermit the Frog, star of the television series THE MUPPET SHOW; the name is used by permission of Henson Associates, Inc. "Kermit" is also Celtic for "free". KERMIT is available for many systems for only a nominal fee from Columbia and from various user group organizations, such as DECUS and SHARE. Author: Paul W. Madaus Johnson Controls, Inc. 507 E. Michigan St. Milwaukee, WI 53201 (414) 274-4528 THIS VERSION OF KERMIT SOURCE WAS ORIGINALLY DESIGNED TO RUN ON THE SPERRY(UNIVAC) 1100. I HAVE CHOSEN TO CONVERT AND IMPLEMENT THIS VERSION OF KERMIT ONTO THE TI-990 DX10 SYSTEMS. THE CONVERSION OF SYSTEM SPECIFIC PROCEDURES WAS STRAIGHTFORWARD, THE BASIC PROTOCOL OF THE UNIVAC VERSION WAS WRITTEN IN STANDARD PASCAL, AND OF ALL THE VERSIONS TESTED FOR CONVERSION, THE UNIVAC VERSION PRODUCED AN ACCEPTABLE AMOUNT OF ERRORS UPON INITIAL DX10 COMPILATION(not a deciding factor - but very influential). BEFORE CONTINUING FURTHER, I WISH TO CREDIT THE ORIGINAL UNIVAC VERSION(2.0) OF THIS PROGRAM TO: Edgar Butt (last known address) Computer Science Center University of Maryland College Park, Maryland 20742 Phone (301) 454-2946 MY METHOD OF RE-DESIGN WILL CONSIST OF REMOVAL OR CONVERSION OF ALL UNIVAC SYSTEM DEPENDENT SOFTWARE, ADDITION OF A COMMAND PARSING MECHANISM, ADDITION OF INTERACTIVE COMMAND CONTROL, ADDITION OF SEVERAL NEW KERMIT COMMANDS, ADDITION OF SIMPLE TTY TYPE TERMINAL EMULATION VIA CONNECT CMD, ADDITION OF REMOTE AS WELL AS LOCAL KERMIT EXECUTION, AND ADDITION OF A PASCAL XOR FUNTION FOR 7th AND 8th BIT SETTING AND RESETTING. THIS PROGRAM MAKES USE OF TI PASCAL EXTENSIONS BUT DOES NOT INCLUDE ANY NON-TI PASCAL STRUCTURES. PROGRAM WAS COMPILED AND LINKED AT DX10 REL. 3.7.0 AND DX10 PASCAL REL. 1.8.0. THE TI PASCAL CONFIGURATION PROCESS WAS NOT USED ONLY FOR GREATER SIMPLICITY AND EASIER PORTABILITY. < more comments to follow in documentation... > } CONST { NEXT TWO CONSTANTS USED IN CONNECT FOR XOFF TUNING } xoff_threshold=800; { NO. OF CHARS TO RECEIVE BEFORE SENDING XOFF } buf_threshold=1000; { GUARD TO AVOID OVERFILLING CHAR BUFFER } maxtry = 5; maxbuf = 200; maxflen=50; { MAXIMUM FILE NAME LENGTH } maxwrt = 132; ascnul = 0; ascsoh = 1; ascbs = 8; asclf = 10; asccr = 13; ascsp = 32; { } ascns = 35; {#} ascamp = 38; {&} ascast = 42; {*} ascper = 46; {.} ascb = 66; {B} ascc = 67; {C} ascd = 68; {D} asce = 69; {E} ascf = 70; {F} ascg = 71; {G} asch = 72; {H} asci = 73; {I} ascl = 76; {L} ascn = 78; {N} asco = 79; {O} ascr = 82; {R} ascs = 83; {S} asct = 84; {T} ascx = 88; {X} ascy = 89; {Y} ascz = 90; {Z} asctil = 126; {~} ascdel = 127; {rubout} mark = ascsoh; crlf='#0D#0A'; { DX10 SVC I/O SUBOPCODES } asslun = #91; { ASSIGN LUNO SVC I/O SUBOPCODE } opnrwd = #03; { OPEN REWIND SVC I/O SUBOPCODE } readas = #09; { READ ASCII SVC I/O SUBOPCODE } writas = #0B; { WRITE ASCII SVC I/O SUBOPCODE } moddev= #15; { MODIFY DEVICE CHARACTERISTICS } rfc=#05; { READ FILE CHARACTERISTICS } genluno=#04; { GENERATE LUNO FLAG SET } lunass=#80; { LUNO ASSIGNED BIT FOR PDT STATUS WORD } ret_sys_info=#3F; { RETURN SYSTEM INFO SVC } pdt_memory=1; { RETURN PDT STRUCTURES } TYPE ascval = 0..255; { A BYTE } { WE'LL NEED STATIC LENGTH STRING BUFFERS ON DX10 } char2=PACKED ARRAY[1..2]OF char; char4=PACKED ARRAY[1..4]OF char; char12=PACKED ARRAY[1..12]OF char; char40=PACKED ARRAY[1..40]OF char; char80=PACKED ARRAY[1..80]OF char; flen=PACKED ARRAY[1..maxflen]OF char; scistring=PACKED ARRAY[0..10]OF char; byte6=PACKED ARRAY[1..6]OF ascval; { FILLERS AND OFFSETS } byte12=PACKED ARRAY[1..12]OF ascval; byte16=PACKED ARRAY[1..16]OF ascval; byte18=PACKED ARRAY[1..18]OF ascval; byte28=PACKED ARRAY[1..28]OF ascval; byte60=PACKED ARRAY[1..60]OF ascval; kermitstates = (kcommand, fininit, byeinit, getinit, wexit, kexit, cexit, { EXIT TO CMD MODE } sinitiate, sheader, sdata, sbreak, rcv, rinitiate, rheader, rdata); filestatus = (closed, open, endfile); ablk=PACKED RECORD { ABORT I/O CALLBLK } op,lun:ascval END; wblk=PACKED RECORD { WAIT I/O SVC } op,err:ascval; addr:integer END; w1blk=PACKED RECORD { WAIT ANY I/O COMPLETION SVC } op:ascval; fil1,fil2,fil3:ascval { ZERO FILLERS } END; eflags = SET OF { EDIT FLAGS } (pass,etx,esc,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12,r13,r14,r15); pblk=PACKED RECORD { PASSTHRU CALLBLK } resv1:integer; eflg:eflags; resv2:integer END; rfcblk=PACKED RECORD { FOR READ FILE CHARACTERISTICS } fil1,fil2,fil3:integer; filesize:longint END; ascbuf = RECORD ln: integer; ch: PACKED ARRAY[1..maxbuf] OF ascval END; sbits = SET of 0..35; btype=ARRAY[1..16] OF integer; { FOR DISPLAY-ACCEPT } suflags= SET OF { SVC FLAGS } (bsy,err,eofil,evnt,f1,f2,f3,f4,qret,rep,f5,f6,f7,opn,ext,blnk); exflags=SET OF { EXTENDED CALL BLOCK FLAGS } (fstrt,inten,blink,graph,asci8,tedit,beep,right,curpos,filchr, noinit,trmchr,noecho,chrval,flderr,wbeep); svcblk = PACKED RECORD { SVC CALLBLOCK } svc, { SVC OPCODE } stat, { STATUS CODE } subop, { SVC I/O SUBOPCODE } lun:ascval; { LUNO } flags:suflags; { SYSTEM AND USER FLAGS } buf:integer; { DATA BUFFER ADDRESS } lrl:integer; { LOGICAL RECORD LENGTH } cc:integer; { CHARACTER COUNT } fil1:integer; { NOT USED } { EXTENDED CALL BLOCK BEGINS HERE - RESERVED FOR FUTURE USE } xblk:exflags; { NOT USED } filorflg:ascval; { FILL CHAR OR ASSIGN LUNO FLAG } event:ascval; { EVENT BYTE } crow:ascval; { CURSOR POSITION - ROW } ccol:ascval; { CURSOR POSITION - COL } frow:ascval; { FIELD START - ROW } fcol:ascval; { FIELD START - COL } devaddr:integer; { DEVICE POINTER FOR ASSIGN LUNO } fil2,fil3:integer { NOT USED } END; svcptr=@svcblk; { SVC POINTER TYPE FOR SCB$A } waitblk = PACKED RECORD { WAIT FOR I/O SVC CALLBLOCK } opcode:ascval; { SVC OPCODE } stat:ascval; { ERROR } svcaddr:integer { ACTUAL SVC I/O ADDRESS (+2) } END; bytebits=SET OF { 16 BITS TO A WORD - FOR XORING } (b15,b14,b13,b12,b11,b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0); svccbt = PACKED RECORD { SVC BLOCK FOR RETURN SYSTEM INFORMATION } opcode, { OPCODE } error, { STATUS } data_type, { TYPE OF STRUCTURE TO RETRIEVE } flags:ascval; { FLAGS } index, { STRUCTURE NUMBER } read_addr, { OFFSET INTO STRUCTURE } buff_len, { READ BUFFER SIZE } ret_len, { NUMBER OF BYTES RETURNED } bufaddr, { READ BUFFER ADDRESS } reserved:integer END; {} pdtrec=PACKED RECORD { BASED ON CURRENT PDT STRUCTURE - NOT AT ALL LIKELY TO CHANGE } addr:integer; fil0:byte6; { FILLER } bsy:ascval; { CONTAINS BUSY BITS } fil1:ascval; { OTHER HALF OF BYTE } fil2:byte18; { FILLER } tiline:ascval; { NEED UPPER PORTION OF TILINE ADDRESS } fil3:ascval; { FILLER } fil4:byte12; { FILLER } devnam:char4; { DEVICE NAME } fil5:byte60; { FILLER } addr2:integer; { SHOULD BE SAME THIS PDT'S ADDR } fil6:byte28; { FILLER } vdtsc1:bytebits; { PORT INITIALIZED WORD } fil7:byte16; { FILLER } init:bytebits; { PORT INITIALIZED WORD } fil8:byte60 { FILLER } END; buf=PACKED ARRAY[1..1024]OF char; { ADJUST IF YOU WISH } VAR { I HOPE I USE ALL THESE!! } iniflg: boolean; {Set true after first initialization} server: boolean; state: kermitstates; filbuf,wrtbuf,redbuf,sndbuf,rcvbuf,cmdbuf: ascbuf; redix: integer; rfile,wfile,lfile: text; { DX10 TEXT FILE TYPES} wbfile:FILE OF char80; { BINARY WRITE FILE } rbfile:FILE OF char80; { BINARY READ FILE } bbuf:char80; { BINARY DATA BUFFER } bptr:integer; { CURRENT BBUF POINTER } fname,rfname,lname,ioname,namebuf,tname:flen; { DX10 FILE PATHS } fnlen,rfnlen,iolen,lnlen,tlen:integer; rstatus, wstatus,lstatus: filestatus; seq,rcvseq: integer; rlen: integer; stype,rcvtyp: ascval; numtry: integer; numcserr: integer; ineoln: boolean; sndonly: boolean; sndlog, rcvlog, wrtlog, redlog: boolean; creol: boolean; lfeol: boolean; crlfeol: boolean; gotcr: boolean; locbsiz: ascval; loctout: ascval; locnpad: ascval; locpad: ascval; loceol: ascval; locquo: ascval; optqu8: ascval; locqu8: ascval; locrep: ascval; rembsiz: ascval; remdsiz: ascval; {Maximum number of data characters to send (remBsiz-3)} remtout: ascval; remnpad: ascval; rempad: ascval; remeol: ascval; remquo: ascval; remqu8: ascval; remrep: ascval; oval:boolean; { IOTERM SETTING SAVE } blk:btype; { FOR DISPLAY-ACCEPT CLEARSCREENS } lun:integer; { FOR INITSCREENS } eolflg:boolean; { DX10 RECORDS DO NOT CONTAIN CRs OR LFs } pcbuf,tcbuf:char2; { CHAR BUFS } ts:svcblk; { TERMINAL SVC I/O CALLBLOCK } ps:svcblk; { PORT SVC I/O CALLBLOCK } sp:svcptr; { SVCBLK POINTER FOR MISC I/O } s:svcblk; rs:rfcblk; { READ FILE CHARACTERISTICS BUFFER } recsred:integer; { NUMBER OF RECORDS READ IN FILE } percent:real; { PERCENT OF FILE SENT TO REMOTE } a:ablk; { ABORT I/O CALLBLK } w:wblk; { WAIT I/O CALLBLK } w1:w1blk; { WAIT ANY I/O CALLBLK } p:pblk; { EDIT FLAG BLOCK FOR PASSTHRU } bsbuf:char40; { BIG USER MESSAGE STRING BUFFER } ssbuf:char12; { SMALL STRING BUFFER - MAINLY FOR THE PROMPT } cond:boolean; { CONNECTED BOOLEAN } pktsnt:integer; { A RUNNING COUNT OF PACKETS SENT } headok:boolean; { HEADER PACKET SENT FLAG } sending:boolean; { SENDING A FILE } receiving:boolean; { RECEIVING A FILE } local:boolean; { MODE WE ARE OPERATING IN } syn,val:scistring; { FOR SYNONYM SETTING } perr:integer; { GET PARM ERR BUF } isc:boolean; { ISC TYPE TERMINAL - OPTIONAL } binary:boolean; { BINARY TYPE FILE FLAG } reof:boolean; { READ FILE EOF ENCOUNTERED FLAG } { FORWARD REFERENCE PROCEDURES } PROCEDURE error(msg:char40);forward; { 40 CHARACTER ERROR MESSAGE } { TI PASCAL EXTERNAL PROCEDURES } { THESE FIRST TWO PROCEDURES DEPEND ON THE EXISTENCE OF TIFORMS ON } { YOUR DX10 SYSTEM AND ARE OPTIONAL SINCE THEY ONLY CLEAR THE } { SCREEN UPON KERMIT INITIALIZATION. YOU MAY REMOVE THEM. } PROCEDURE initscreen(VAR block:btype; unit : integer );external; { TIFORMS } PROCEDURE clearscreen( VAR block : btype);external; { TIFORMS } PROCEDURE delay(l:longint);external; { DELAY L millisecs } PROCEDURE p$parm(num:integer; { GET PARMS FROM CALLING PROC } VAR str:PACKED ARRAY[1..?]OF char;VAR err:integer);external; PROCEDURE store$syn(VAR syn,value:scistring);external; PROCEDURE set$acnm(locvar,locfil:integer);external; { SET PASCAL FILE NAMES } PROCEDURE setpdt(w1addr,w2addr:integer);external; { NOT TI PROC } { ASSEMBLY - SET PORT INIT BITS FOR 2 WORDS IN PDT IF OPEN FAILS } PROCEDURE svc$(call_blk_addr:integer);external; { PROCESS SVC } FUNCTION scb$a(fileloc:integer):svcptr;external; { GET TI FILE CHARACTERISTICS } { ***************************************************************** } PROCEDURE passt(VAR s:svcblk;onoff:boolean); { SET OR RESET THE PASSTHRU MODE - DEVICE MUST ALREADY BE OPEN } BEGIN { PASST } { SET TERMINAL PASSTHRU MODE } IF onoff THEN p.eflg:=[pass] { SET PASSTHRU FLAG } ELSE p.eflg:=[]; { RESET PASSTHRU FLAG } p.resv1:=0; p.resv2:=0; s.flags:=[]; { WAIT FOR COMPLETION } s.subop:=moddev; { SET MODIFY DEVICE SUBOPCODE } s.buf:=location(p); s.cc:=6; svc$(location(s)) { SET PASSTHRU MODE } END; { PASST } PROCEDURE abort(VAR s:svcblk); BEGIN IF bsy IN s.flags THEN BEGIN a.op:=15; { SET ONCE ABORT I/O OPCODE } a.lun:=s.lun; svc$(location(a)); w.op:=1; { SET ONCE WAIT I/O OPCODE } w.err:=0; { NOW WAIT FOR THIS ABORT COMPLETION } w.addr:=location(s)+2; svc$(location(w)) END END; PROCEDURE chktrm(devname:char4); VAR sys_info : svccbt; { USED TO GET PDTs } pdt_addr :integer; { PDT ADDRESS SAVE } pdt:pdtrec; { GENERAL PDT STRUCTURE } vdtaddr,iniaddr:integer; { ADDRESS BUFFERS THE TWO PDT INIT WORDS } BEGIN { CHKTRM } vdtaddr:=-1; { NOT A VALID PDT ADDRESS YET } iniaddr:=-1; { NOT A VALID PDT ADDRESS YET } IF devname[1]='S' AND devname[2]='T' THEN WITH sys_info DO { SEARCH FOR DEVICES PDT } BEGIN opcode:=ret_sys_info; error:=0; data_type:=pdt_memory; { RETRIEVE PDT STRUCTURES } flags:=0; index:=0; { START AT BEGINNING OF PDT LIST } read_addr:=0; { OFFSET INTO PDT } buff_len:=size(pdt); { SIZE OF READ BUFFER } ret_len:=0; { ACTUAL NUMBER OF BYTES READ } bufaddr:=location(pdt); reserved:=0; REPEAT index:=succ(index); { GET NEXT PDT ENTRY } pdt_addr:=pdt.addr; { POINTER TO NEXT PDT } svc$(location(sys_info)); { GET NEXT PDT } IF pdt.devnam=devname AND error=0 THEN BEGIN { FOUND THE DEVICE } IF index=1 THEN { IF FIRST PDT ON LIST THEN WE HAVE } pdt_addr:=pdt.addr2; { TO GET ITS ADDR WITHIN PDT } IF (pdt.bsy=0 OR pdt.bsy=lunass) AND { ONLY ALLOW LUNO ASSISNED BIT SET IN PDT STATUS WORD i.e. not busy } pdt.tiline>= #F8 AND { MAKE SURE STATION COMING OFF CI403 BOARD --> TILINE TYPE ADDR } NOT (b2 IN pdt.vdtsc1 AND { SEE IF ONE OR BOTH } b2 IN pdt.init) THEN { WORDS NEEDS MODIFICATION } { ALL THE ABOVE CONDITIONS MUST BE SATISFIED FOR THIS FINAL ATTEMPT } { TO OPEN A 931 PORT TO EVEN BE ATTEMPTED. ADDRESSES OF WORDS WILL } { BE SET THAT NEED BIT MODIFICATION, ELSE ADDRESSES REMAIN AT -1 } BEGIN IF NOT b2 IN pdt.vdtsc1 THEN { NEED BIT SET } vdtaddr:=pdt_addr+location(pdt.vdtsc1)-location( pdt ); { SO SET ADDRESS OF WORD TO BE MODIFIED } IF NOT b2 IN pdt.init THEN { SAME FOR THIS WORD } iniaddr:=pdt_addr+location(pdt.init)-location(pdt ); setpdt(vdtaddr,iniaddr) { SET APPROPRIATE PDT BITS } END END UNTIL pdt.addr=0 OR pdt.devnam=devname OR error<>0 END END; { CHKTRM } PROCEDURE initio(dev:integer;VAR s:svcblk); VAR devnam:char4; { DEVICE NAME TO OPEN } BEGIN { INITIO } IF s.stat=0 THEN { CHECK FOR ANY PREVIOUS ERR } WITH s DO BEGIN svc:=0; { SVC I/O } subop:=asslun; { ASSIGN LUNO OPERATION } lun:=0; { SYSTEM WILL PICK THE LUNO } flags:=[]; { USE EXTENDED CALLBLOCK } buf:=0; { CLEAR } lrl:=0; { CLEAR } cc:=0; { CLEAR } fil1:=0; { CLEAR } xblk:=[]; { CLEAR } filorflg:=genluno; { SYSTEM TO GENERATE LUNO NUMBER } event :=0; { CLEAR } crow :=0; { CLEAR } ccol :=0; { CLEAR } frow :=0; { CLEAR } fcol :=0; { CLEAR } devaddr:=dev; { DEVICE NAME POINTER } fil2:=0; { CLEAR } fil3:=0; { CLEAR } svc$(location(s)); { PERFORM THE SVC } IF stat=0 THEN { LUNO ASSIGNMENT COMPLETE } BEGIN { OPEN DEVICE FOR I/O } filorflg :=0; { CLEAR } devaddr:=0; { CLEAR } subop:=opnrwd; { SET OPEN REWIND OPERATION FOR DEVICE } flags:=[qret]; { QUICK RETURN SO WE CAN CHECK OPEN } svc$(location(s)); { OPEN THE DEVICE } delay(500); { ALLOW OPEN OF DEVICE TO PROCEED } IF bsy IN flags THEN BEGIN { OPEN NOT COMPLETE YET } delay(3000); { WAIT SOME MORE } IF bsy IN flags THEN BEGIN abort(s); { ABORT AND CHECK PORT'S PDT INIT WORDS } stat:=0; IF dev=location(ioname) THEN BEGIN { PDT MAY NEED INITIALIZATION } FOR i:=1 TO 4 DO devnam[i]:=ioname[(i+1)]; chktrm(devnam) { CHECK AND POSSIBLY MODIFY PDT PORT INIT BITS } END; svc$(location(s)); { TRY ONE MORE ATTEMPT } delay(2000); IF bsy IN flags THEN stat:= #FF { COULDN'T OPEN DEVICE SET ERROR } END END; flags:=[]; { RESET FLAGS } IF stat=0 AND dev=location(ioname) THEN passt(s,true); { SET PASSTHRU MODE ON REMOTE PORT } lrl:=1 { FOR MOST READS } END END END; { INITIO } { IN SOME PROCEDURES I CALL SVC$ DIRECTLY FOR QUICKER I/O } PROCEDURE readdev(VAR rs:svcblk;wait:boolean;bufloc:integer); BEGIN rs.subop:=readas; rs.buf:=bufloc; IF wait THEN { WAIT I/O COMPLETION } rs.flags:=rs.flags-[qret] ELSE rs.flags:=rs.flags+[qret]; svc$(location(rs)) { DO THE READ } END; PROCEDURE writdev(VAR rs:svcblk;wait:boolean; numchars:integer;bufloc:integer); BEGIN rs.subop:=writas; rs.buf:=bufloc; rs.cc:=numchars; IF wait THEN { WAIT I/O COMPLETION } rs.flags:=rs.flags-[qret] ELSE rs.flags:=rs.flags+[qret]; svc$(location(rs)) { DO THE WRITE } END; FUNCTION devbsy(ds:svcblk):boolean; BEGIN devbsy:=bsy IN ds.flags { DEVICE DOING I/O ? } END; {$NO WARNINGS} FUNCTION bxor(i:integer;b:ascval):ascval; { XOR 128/64 } VAR a:bytebits; { BIT MANIPULATION NEEDED } BEGIN { BXOR } a:= b::bytebits; { TYPE CONVERT FOR BIT MANIPULATION } IF i = 64 THEN BEGIN { XOR 64 } IF ( b6 IN a ) THEN a:=a - [b6] { RESET BIT 6 } ELSE a:=a+ [b6] { SET BIT 6 } END; { XOR 64 } IF i = 128 THEN BEGIN { XOR 128 } IF ( b7 IN a ) THEN a:=a- [b7] { RESET BIT 7 } ELSE a:=a+[b7] { SET BIT 7 } END; { XOR 128 } { NO OTHER XORS DONE IN THIS PROTOCOL } b:=a::ascval; { TYPE CONVERT FOR COMPATABILITY } bxor:=b { RETURN FUNCTION VALUE } END; { BXOR } {$WARNINGS} FUNCTION makechar (i: integer): ascval; BEGIN makechar:=ascsp+i END; FUNCTION unchar (a: ascval): integer; BEGIN unchar:=a-ascsp END; FUNCTION tog64(a: ascval): ascval; BEGIN tog64:=bxor(64,a) {System dependent} END; FUNCTION tog128(a: ascval): ascval; BEGIN tog128:=bxor(128,a) {System dependent} END; FUNCTION checksum (sum: integer): ascval; BEGIN { SINGLE CHARACTER ARITHMETIC CHECKSUM } checksum := (((sum MOD 256) DIV 64) + sum) MOD 64 END; PROCEDURE logopn; { OPEN LOG FILE - IF DEMANDED } BEGIN set$acnm(location(lfile),location(lname)); { SET PASCAL FILE NAME } rewrite(lfile); { OPEN LOG FILE FOR WRITING } lstatus:=open; { ASSUME SUCCESS } write(lfile,'DX10 KERMIT-990 --- LOGFILE'); writeln(lfile); bsbuf:='LOGGING REQUESTED TO: '; writdev(ts,true,22,location(bsbuf)); FOR i:=1 TO ord(lname[1]) DO BEGIN tcbuf[1]:=lname[(i+1)]; writdev(ts,true,1,location(tcbuf)) END; tcbuf:='#0D#0A'; writdev(ts,true,2,location(tcbuf)) END; PROCEDURE logcls; BEGIN IF lstatus=open THEN close(lfile) { CLOSE THE LOG FILE } END; { Buffer routines - FOLLOW } PROCEDURE bufinit(VAR buf:ascbuf); BEGIN buf.ln:=0 END; PROCEDURE putbuf(VAR buf: ascbuf; a:ascval); BEGIN IF NOT (buf.lnmaxflen THEN len:=maxflen; FOR i:=1 TO len DO BEGIN a:=buf.ch[i]; IF a>127 THEN a:=a-127; l[(i+1)]:=chr(a) END; l[1]:=chr(len) { NEED FILE LENGTH } END; { Process parameters to and from remote Kermit } PROCEDURE putpar; VAR temp: ascval; BEGIN bufinit(filbuf); putbuf(filbuf,makechar(locbsiz)); putbuf(filbuf,makechar(loctout)); putbuf(filbuf,makechar(locnpad)); putbuf(filbuf,tog64(locpad)); putbuf(filbuf,makechar(loceol)); putbuf(filbuf,locquo); temp:=ascsp; { SO FAR NO EIGHT BIT QUOTING } IF locqu8<>0 THEN temp:=locqu8; putbuf(filbuf,temp); putbuf(filbuf,ascsp); {Only know how do to 1 character checksum} temp:=ascsp; IF locrep<>0 THEN temp:=locrep; putbuf(filbuf,temp) END; PROCEDURE getpar; BEGIN IF rcvbuf.ln > 0 THEN rembsiz:=unchar(rcvbuf.ch[1]); IF rcvbuf.ln > 1 THEN remtout:=unchar(rcvbuf.ch[2]); IF rcvbuf.ln > 2 THEN remnpad:=unchar(rcvbuf.ch[3]); IF rcvbuf.ln > 3 THEN rempad:=tog64(rcvbuf.ch[4]); IF rcvbuf.ln > 4 THEN remeol:=unchar(rcvbuf.ch[5]); IF rcvbuf.ln > 5 THEN remquo:=rcvbuf.ch[6]; IF rcvbuf.ln > 6 THEN remqu8:=rcvbuf.ch[7]; { DONT GET CHCKSUM - WE ARE ONLY SET UP FOR SINGLE CHAR CHCKSUM } IF rcvbuf.ln > 8 THEN remrep:=rcvbuf.ch[9]; " remdsiz:=rembsiz-3; remdsiz:=rembsiz-6; { SEND LESS DATA - EXCEEDING REMOTE BUFS } IF state=rinitiate THEN {Our parameters have not been sent} BEGIN IF locqu8=0 THEN remqu8:=0; { WE DONT WANT 8-BIT QUOTING } IF ((32remquo) THEN BEGIN locqu8:=ascy {Remote Kermit specified 8-bit quote character} END ELSE IF remqu8=ascy THEN BEGIN locqu8:=ascamp; IF (locqu8=remquo) OR (locqu8=remrep) THEN locqu8:=asctil; IF (locqu8=remquo) OR (locqu8=remrep) THEN locqu8:=ascns; remqu8:=locqu8 END ELSE BEGIN locqu8:=0; {Don't do 8-bit quoting} remqu8:=0 END; IF ((32remquo) AND (remrep<>remqu8) AND (locrep<>0) THEN BEGIN locrep:=remrep {Agree to do repeat counts} END ELSE BEGIN remrep:=0; locrep:=0 END END ELSE {Our parameters have already been sent} BEGIN IF (remqu8<>ascy) AND (remqu8<>locqu8) THEN BEGIN locqu8:=0 {Don't do 8-bit quoting} END; IF remrep<>locrep THEN locrep:=0 {Don't do repeat counts} END END; PROCEDURE rcvpkt; { rcvtyp = 0 - no soh encountered 1 - soh encountered, but packet incomplete 2 - Checksum error Other - ASCII value of packet type from good packet rcvseq = -1 - Not a valid packet 0...63 - Sequence number from valid packet rcvbuf.ln - number of ascii values input since last SOH rcvbuf.ch - array of ascii values input } VAR c:PACKED ARRAY[1..2]OF char; av,rt: ascval; rst,rsq,cs:integer; cct:integer; dlay:integer; { A DELAY COUNTER } dtim:longint; { VARIABLE DELAY TIMES } BEGIN cct:=0; IF rcvlog THEN write(lfile,'RCV <'); rcvtyp:=0; rcvseq:=-1; { NO VALID PACKET YET } rst:=0; ineoln:=false; bufinit(rcvbuf); { FOR OPTIMAL SPEED WE WILL AVOID THE PROCEDURE CALL TO READ A CHAR } ps.subop:=readas; ps.buf:=location(c); ps.flags:=ps.flags+[qret]; svc$(location(ps)); { QUEUE THE READ } WHILE NOT ineoln AND cct<230 DO { UNTIL END OF PACKET OR UNTIL NO SOH LIMIT REACHED } BEGIN dlay:=0; { CLEAR DELAY COUNTER } dtim:=0; { NO INITIAL DELAY } { THIS WHILE LOOP MAY BE FINE TUNED IF NECESSARY } WHILE (bsy IN ps.flags) AND dtim<=200 DO BEGIN delay(dtim); { VARIABLE DELAY BEGINS WITH ZERO } dlay:=succ(dlay); { INCREMENT TIME COUNTER } { THIS DELAY MECHANISM MAY NEED FINE(or GROSS) TUNING } IF( (dlay MOD 10) = 0) THEN dtim:=dtim+50 { WAIT LONGER NEXT TIME } END; IF bsy IN ps.flags THEN { READ CHARACTER COULD NOT COMPLETE IN ABOUT FIVE SECONDS } ineoln:=true { SO LEAVE --> RESEND LAST PACKET } ELSE { WE READ A CHAR } BEGIN IF rcvlog THEN BEGIN IF ps.stat<>0 THEN write(lfile,'^^ERR IN PORT READ: ',ps.stat hex,' ^^') ELSE write(lfile,c[1]) END; cct:=succ(cct); av:=ord(c[1]); { WE HAVE THE CHAR - SO REQUEUE THE NEXT READ } svc$(location(ps)); { QUEUE NEXT READ WHILE PROCESSING LAST CHAR } IF av=mark THEN rst:=1; CASE rst OF 0: {Mark character never encountered.} BEGIN putbuf(rcvbuf,av); END; 1: {Mark character.} BEGIN rcvtyp:=1; rcvseq:=-1; cct:=0; { CLEAR PACKET OK } bufinit(rcvbuf); rst:=2 END; 2: {Length of the packet.} BEGIN cs:=av; {Initialize checksum} rlen:=unchar(av)-3; rst:=3 END; 3: {Packet number.} BEGIN cs:=cs+av; rsq:=unchar(av); rst:=4 END; 4: {Packet type.} BEGIN cs:=cs+av; rt:=av; {remember the packet type} rst:=5; IF rlen=0 THEN rst:=6 END; 5: {Data portion.} BEGIN cs:=cs+av; putbuf(rcvbuf,av); IF rcvbuf.ln = rlen THEN rst:=6 END; 6: {Checksum.} BEGIN IF checksum(cs)=unchar(av) THEN BEGIN rcvtyp:=rt; rcvseq:=rsq; ineoln:=true {Ignore the rest of the line} { CARRIAGE CONTROL CHAR WILL BE READ FROM NEXT QUEUED READ } END ELSE BEGIN numcserr:=numcserr+1; rst:=0; {Look for another mark} rcvtyp:=2; {Indicate checksum error} ineoln:=true { RETURN ERR NOW } END END END { CASE } END { ELSE - NOT BSY --> CHAR READ } END; IF rcvlog THEN writeln(lfile,'>'); IF cct>=230 THEN { AFTER RECEIVING 230 UNSUCCESSFUL CHARACTERS - IT'S TIME TO RESET } error('#0D#0A230 CHARS AND STILL NO VALID PACKET.#0D#0A'); IF bsy IN ps.flags THEN abort(ps) { CLEAN UP BEFORE WE LEAVE } END; { RCVPKT } { Build and send packets PROCEDURES } PROCEDURE makepacket(ptype: ascval; seq, len: integer); VAR c: ascval; cs: integer; BEGIN bufinit(sndbuf); FOR i:=1 TO remnpad DO { ADD PAD CHARS IF ANY TO BE ADDED } putbuf(sndbuf,rempad); putbuf(sndbuf,mark); { SOH MARKER } c:=makechar(len+3); cs:=c; {Initialize checksum} putbuf(sndbuf,c); { LENGTH OF PACKET } c:=makechar(seq); cs:=cs+c; putbuf(sndbuf,c); { PACKET SEQ NUMBER } c:=ptype; cs:=cs+c; putbuf(sndbuf,c); { PACKET TYPE } FOR i:=1 TO len DO BEGIN c:=filbuf.ch[i]; cs:=cs+c; putbuf(sndbuf,c) { ADD PACKET DATA } END; c:=makechar(checksum(cs)); putbuf(sndbuf,c); { ADD CHECKSUM TO PACKET } IF (remeol<>asccr) AND (remeol<>asclf) THEN putbuf(sndbuf,remeol) { EOL MARKER AT END OF PACKET } END; PROCEDURE sndpkt; VAR { NEED CONTIGUOUS PACKED DATA FOR SVC } tbuf:PACKED ARRAY[1..maxbuf]OF ascval; ens:integer; { ENCODE PROCEDURE ERROR BUFFER } BEGIN IF sndlog THEN write(lfile,'SND <'); FOR i:=1 TO sndbuf.ln DO BEGIN tbuf[i]:=sndbuf.ch[i]; { PACK DATA FOR SVC } IF sndlog THEN { LOG IT } write(lfile,chr(sndbuf.ch[i])) END; tbuf[sndbuf.ln+1]:= #0D; { SEND EOL CHAR } IF sndlog THEN write(lfile,'#0D'); { LOG IT } writdev(ps,true,(sndbuf.ln+1),location(tbuf)); {WRITE(send) PACKET} IF ps.stat<>0 AND sndlog THEN write(lfile,' ERR IN SNDPKT: ',ps.stat hex,' '); IF local THEN BEGIN { DISPLAY SEND OR RECEIVE STATS } IF sending THEN BEGIN {$NO WARNINGS} percent:=recsred/rs.filesize*100; { PERCENT OF FILE SENT SO FAR } {$WARNINGS} ssbuf:=' % #0D'; { DISPLAY % TEMPLATE } IF state=sbreak THEN { DONE SENDING THIS FILE } BEGIN sending :=false; { BREAK OUT OF HERE } ssbuf:='100.0% OK#0D#0A' END ELSE encode(ssbuf,1,ens,percent:5:1); { PLACE PERCENT IN STRING } writdev(ts,true,12,location(ssbuf)) { DISPLAY PERCENT COMPLETE } END ELSE IF receiving THEN BEGIN pktsnt:=succ(pktsnt); ssbuf:='<=#0D#0A '; IF rcvtyp=ascb THEN { DONE RECEIVING THIS FILE } BEGIN receiving:=false; ssbuf:=' COMPLETE#0D#0A'; writdev(ts,true,12,location(ssbuf)) END ELSE BEGIN IF pktsnt>=36 THEN { NEW LINE FOR NEAT FORMAT } BEGIN writdev(ts,true,4,location(ssbuf)); pktsnt:=0 END ELSE writdev(ts,true,2,location(ssbuf)) END END END; IF sndlog THEN writeln(lfile,'>') END; { File output PROCEDURES } PROCEDURE wrtrec; VAR c:char; BEGIN IF wrtlog THEN write(lfile,'WRT ['); FOR i:=1 TO wrtbuf.ln DO BEGIN c:=chr(wrtbuf.ch[i]); { ASCII VALUE MAY BE >127 } IF NOT binary THEN write(wfile,c) { TEXT CHARACTER } ELSE BEGIN bptr:=succ(bptr); { ADVANCE BINARY CHAR BUF PTR } IF bptr>size(bbuf) THEN { BUF FULL -> WRITE IT } BEGIN write(wbfile,bbuf); { WRITE BUF INCLUDING TRAIL BLNKS } bptr:=1 { RESET BUF PTR } END; bbuf[bptr]:=c { STORE OUR CHAR } END; IF wrtlog THEN write(lfile,c) END; IF NOT binary THEN writeln(wfile); IF wrtlog THEN writeln(lfile,']'); bufinit(wrtbuf) END; PROCEDURE wrtcls; {System dependent} BEGIN IF wstatus=open THEN BEGIN IF wrtbuf.ln>0 THEN wrtrec; IF binary THEN { TAKE CARE OF REMAINING BINARY CHARS } BEGIN FOR i:=(bptr+1) TO (size(bbuf)) DO bbuf[i]:=' '; { BLANK FILL REST OF RECORD } write(wbfile,bbuf); { WRITE LAST BINARY RECORD } close(wbfile) END ELSE close(wfile) { CLOSE THE FILE BEING WRITTEN } END; wstatus:=closed END; PROCEDURE wrtopn; VAR wstat: boolean; BEGIN wrtcls; IF binary THEN BEGIN { OPEN SPECIAL FILE FOR BINARY CHARS } { ACTUALLY WE USE FILE OF CHAR80 TO AVOID TRAIL BLNK TRUNCATION } set$acnm(location(wbfile),location(fname)); { SET PASCAL NAME } ioterm(wbfile,oval,false); { TURN OFF I/O TERM ON ERR } rewrite(wbfile); { I HOPE THEY WANT A CLEAR FILE } wstat:= status(wbfile)=0; { CHECK FOR OPEN ERROR } ioterm(wbfile,oval,true) { TURN BACK ON I/O TERM ON ERR } END ELSE BEGIN { OPEN NORMAL TEXT FILE FOR NON-BINARY DATA } set$acnm(location(wfile),location(fname)); { SET PASCAL NAME } ioterm(wfile,oval,false); { TURN OFF I/O TERM ON ERR } rewrite(wfile); { I HOPE THEY WANT A CLEAR FILE } wstat:= status(wfile)=0; { CHECK FOR OPEN ERROR } ioterm(wfile,oval,true) { TURN BACK ON I/O TERM ON ERR } END; IF wstat THEN wstatus:=open; bufinit(wrtbuf) END; PROCEDURE wrtasc(a:ascval); BEGIN IF wrtbuf.ln >=maxwrt THEN wrtrec; putbuf(wrtbuf,a) END; PROCEDURE putrec(buf: ascbuf); { Process data portion of data packet } VAR i,repcnt:integer; a:ascval; qflag: boolean; BEGIN i:=1; WHILE i<= buf.ln DO BEGIN a:=buf.ch[i]; i:=succ(i); repcnt:=1; IF a=remrep THEN BEGIN { REPEAT CHAR SYMBOL FOUND } repcnt:=unchar(buf.ch[i]); { GET REPEAT COUNT } i:=succ(i); a:=buf.ch[i]; { CHAR TO REPEAT } i:=succ(i) END; qflag:= a=remqu8; { 8th BIT SET } IF qflag THEN BEGIN { THEN HANDLE IT } a:=buf.ch[i]; i:=succ(i) END; IF a=remquo THEN BEGIN { 7th BIT SET } a:=buf.ch[i]; i:=succ(i); IF (a<>remquo) AND (a<>remqu8) AND (a<>remrep) THEN a:=tog64(a) END; IF qflag THEN a:=tog128(a); FOR j:=1 TO repcnt DO BEGIN { WRITE DATA TO FILE } IF a=asclf THEN BEGIN IF lfeol OR gotcr THEN BEGIN wrtrec; gotcr:=false END ELSE BEGIN wrtasc(a) END END ELSE BEGIN IF gotcr THEN BEGIN wrtasc(asccr); gotcr:=false END; IF a=asccr THEN BEGIN IF creol THEN BEGIN wrtrec END ELSE IF crlfeol THEN BEGIN gotcr:=true END ELSE BEGIN wrtasc(a) END END ELSE BEGIN wrtasc(a) END END END END END; PROCEDURE redrec; { File input } VAR c: char; a: ascval; BEGIN bufinit(redbuf); IF redix >= 0 AND NOT binary THEN readln(rfile); { GET TEXT RECORD TO TASK } IF binary THEN BEGIN IF eof(rbfile) THEN reof:=true ELSE read(rbfile,bbuf) { READ 80 CHAR RECORD } END; redix:=0; IF NOT binary THEN reof:= eof(rfile); IF NOT reof THEN { NOT EOF ON FILETYPE IN USE } BEGIN { BINARY TYPE OR TEXT TYPE NOT EOF YET } IF redlog THEN write(lfile,'RED ['); IF NOT binary THEN WHILE NOT eoln(rfile) DO BEGIN { PROCESS TEXT RECORD } read(rfile,c); IF redlog THEN write(lfile,c); a:=ord(c); putbuf(redbuf,a) END ELSE FOR i:=1 TO size(bbuf) DO BEGIN IF redlog THEN write(lfile,bbuf[i]); a:=ord(bbuf[i]); putbuf(redbuf,a) END; recsred:=succ(recsred); { NUMBER OF RECORDS READ } IF redlog THEN writeln(lfile,']'); IF creol OR crlfeol THEN putbuf(redbuf,asccr); IF lfeol OR crlfeol THEN putbuf(redbuf,asclf) END END; PROCEDURE redopn; {System dependent} VAR rstat: boolean; BEGIN rstatus:=closed; IF NOT binary THEN BEGIN set$acnm(location(rfile),location(fname)); { SET PASCAL NAME } ioterm(rfile,oval,false); { TURN OFF I/O TERM ON ERR } reset(rfile); { OPEN FILE FOR READING } rstat:= status(rfile)=0; { CHECK FOR OPEN ERROR } ioterm(rfile,oval,true) { TURN BACK ON I/O TERM ON ERR } END ELSE { BINARY FILE TYPE } BEGIN set$acnm(location(rbfile),location(fname)); { SET PASCAL NAME } ioterm(rbfile,oval,false); { TURN OFF I/O TERM ON ERR } reset(rbfile); { OPEN FILE FOR READING } rstat:= status(rbfile)=0; { CHECK FOR OPEN ERROR } ioterm(rbfile,oval,true) { TURN BACK ON I/O TERM ON ERR } END; IF rstat THEN BEGIN rstatus:=open; IF NOT binary THEN sp:=scb$a(location(rfile)) { GET CALLBLOCK OF FILE OPENED } ELSE { BINARY } sp:=scb$a(location(rbfile)); { GET CALLBLOCK OF FILE OPENED } s.svc:=0; { SET UP READ FILE CHARACTERISTICS } s.subop:=rfc; { SUBOPCODE } s.buf:=location(rs); { CHARACTERISTICS BUFFER } s.lrl:=size(rs); s.lun:=sp@.lun; { LUNO NUMBER } svc$(location(s)); { PERFORM THE SVC } IF lstatus = open THEN BEGIN { RECORD SVC STATUS AND FILE SIZE } writeln(lfile,'THE SVC RFC STATUS: ',s.stat hex); writeln(lfile,'FILE SIZE IS: ',rs.filesize); END; { RS.FILESIZE IS THE NO. OF RECORDS IN FILE USED FOR DISPLAYING % } IF rs.filesize=0 THEN rs.filesize:=100; recsred:=0 END; reof:=false; { NO EOF ENCOUNTERED YET } redix:= -1; redbuf.ln:= -1 END; PROCEDURE redcls; BEGIN IF rstatus=open THEN { SEE IF FILE IS OPEN } BEGIN IF NOT binary THEN close(rfile) { CLOSE THE FILE } ELSE close(rbfile) END; rstatus:=closed END; PROCEDURE getrec; { Build data portion of data packet } VAR a: ascval; exit: boolean; prevln,previx,tix: integer; BEGIN bufinit(filbuf); { WE MUST IMPLEMENT SPECIAL EOF HANDLING FOR FILE OF CHAR80 } IF (NOT binary AND eof(rfile)) OR (binary AND reof) THEN BEGIN rstatus:=endfile END ELSE BEGIN exit:=false; REPEAT IF redix >= redbuf.ln THEN BEGIN redrec; IF (NOT binary AND eof(rfile)) OR (binary AND reof) THEN BEGIN exit:=true; IF filbuf.ln=0 THEN rstatus:=endfile END END; IF redix < redbuf.ln THEN BEGIN prevln:=filbuf.ln; previx:=redix; redix:=redix+1; a:=redbuf.ch[redix]; IF locrep<>0 THEN BEGIN tix:=redix+1; WHILE (a=redbuf.ch[tix]) AND (tix<=redbuf.ln) DO tix:=tix+1; tix:=tix-redix; {tix is now the repeat count} IF tix>3 THEN BEGIN IF tix>94 THEN tix:=94; putbuf(filbuf,locrep); putbuf(filbuf,makechar(tix)); redix:=redix-1+tix END END; IF (a>127) THEN BEGIN IF locqu8<>0 THEN putbuf(filbuf,locqu8); a:=tog128(a) END; IF (a<32) OR (a=ascdel) THEN BEGIN putbuf(filbuf,locquo); a:=tog64(a) END; IF (a=locquo) OR (a=locqu8) OR (a=locrep) THEN BEGIN putbuf(filbuf,locquo) END; putbuf(filbuf,a); IF filbuf.ln >= remdsiz THEN BEGIN exit:=true; IF filbuf.ln>remdsiz THEN BEGIN {Character expansion caused buffer length to be exceeded. Back up.} filbuf.ln:=prevln; redix:=previx END END END UNTIL exit END END; PROCEDURE gencmd(r:ascbuf); BEGIN { GENCMD } IF r.ch[1]=ascl THEN { EXIT KERMIT AND LOGOFF } BEGIN sndpkt; { SEND ACK } ssbuf:='$QUIT '; { SCI SYNONYM FOR LOGOFF UPON EXIT } FOR i:=1 TO 5 DO syn[i]:=ssbuf[i]; syn[0]:='#05'; { SET SYN LENGTH } ssbuf:='YES '; { VALUE OF SYNONYM } FOR i:=1 TO 3 DO val[i]:=ssbuf[i]; { MOVE IT } val[0]:='#03'; { LENGTH } store$syn(syn,val); { SET $QUIT SYN IN CALLING PROC } server:=false; { EXIT SERVER } state:=kexit { EXIT KERMIT } END ELSE IF r.ch[1]=ascf THEN { JUST EXIT KERMIT } BEGIN sndpkt; { SEND ACK } server:=false; { EXIT SERVER } state:=kexit { EXIT KERMIT } END ELSE error('UNSUPPORTED GENERIC COMMAND. ') END; { GENCMD } PROCEDURE sendinitiate; { Send states } BEGIN IF fnlen>0 THEN BEGIN redopn; IF rstatus=open THEN BEGIN putpar; {Put parameters into buffer} makepacket(ascs,seq,filbuf.ln); {Make packet with our parameters} numtry:=0; state:=sheader END ELSE error('ERROR OPENING READ FILE ') END ELSE error('NO READ FILE SPECIFIED ') END; PROCEDURE sendheader; VAR wrkbuf:flen; { WORKING BUFFER FOR FILENAME EXTRACTION } cptr:integer; { A TEMP CHAR POINTER } BEGIN IF rcvtyp=ascy THEN BEGIN headok:=true; IF NOT sndonly THEN getpar; {Get parameters from ACK of 'S' packet} IF rfnlen>0 THEN BEGIN { USER SPECIFIED REMOTE FILENAME - USE AS IS } lintobuf(rfname,rfnlen,filbuf) {Send remote file name.} END ELSE BEGIN { USE LOCAL FILE NAME FOR REMOTE } { WE MUST STRIP ANY UNUSUAL CHARS AND/OR DIRECTORY NAMES FROM LOCAL PATH TO BUILD A REMOTE FILENAME. KERMIT DOES ALLOW THE USE OF A DOT WITHIN A FILENAME, BUT SINCE DX10 DOESN'T AND DX10 IS THE ORIGINATING SYSTEM, WE WILL ONLY ALLOW UPPERCASE CHARS AND DIGITS WITHIN A FILENAME. IF THE USER WANTS ANYTHING ELSE - THEN USE THE REMOTE FILE OPTION ON SEND COMMAND - THAT'S WHAT IT'S THERE FOR. } FOR k:=1 TO maxflen DO wrkbuf[k]:=' '; { CLEAR FILE NAME WORKING BUFFER } cptr:=fnlen+1; { POINT TO END OF FILENAME } WHILE cptr>2 AND fname[cptr]<>'.' DO BEGIN { EXTRACT LOCAL FILE NAME FOR REMOTE } IF fname[cptr]<>'$' AND fname[cptr]<>'_' THEN wrkbuf[cptr]:=fname[cptr] ELSE { WE'LL REPLACE ANY ILLEGAL CHARS WITH 0 - SORRY } wrkbuf[cptr]:='0'; cptr:=pred(cptr) END; { GOT A FILE NAME - NOW PUT IN RIGHT PLACE } rfnlen:=2; { NOW KEEP TRACK OF LENGTH ALSO } FOR k:=1 TO maxflen DO IF wrkbuf[k]<>' ' THEN BEGIN { EXTRACT GOOD NAME FROM WORKING BUFFER } rfname[rfnlen]:=wrkbuf[k]; { GRAB A GOOD CHAR } rfnlen:=succ(rfnlen) END; rfnlen:=rfnlen-2; { ADJUST FOR TRUE NAME LENGTH } rfname[1]:=chr(rfnlen); lintobuf(rfname,rfnlen,filbuf) { SEND ADJUSTED FILE NAME } END; numtry:=0; seq:=(seq+1) MOD 64; makepacket(ascf,seq,filbuf.ln); state:=sdata END END; PROCEDURE senddata; BEGIN IF rcvtyp=ascy THEN BEGIN IF headok THEN { LAST PACKET - FILE HEADER WAS ACKed } BEGIN sending:=true; { START SENDING FILE } headok:=false; { RESET HEADER FLAG } bsbuf:= 'SENDING FILE: '; writdev(ts,true,15,location(bsbuf)); FOR k:=1 TO fnlen DO bsbuf[k]:=fname[k+1]; writdev(ts,true,fnlen,location(bsbuf)); ssbuf:=' ==> '; writdev(ts,true,5,location(ssbuf)); FOR k:=1 TO rfnlen DO bsbuf[k]:=rfname[k+1]; writdev(ts,true,rfnlen,location(bsbuf)); tcbuf:=crlf; writdev(ts,true,2,location(tcbuf)) END; getrec; numtry:=0; seq:=(seq+1) MOD 64; IF rstatus = open THEN makepacket(ascd,seq,filbuf.ln) ELSE BEGIN makepacket(ascz,seq,0); state:=sbreak; fnlen:=0 END END END; PROCEDURE sendbreak; BEGIN IF rcvtyp=ascy THEN BEGIN numtry:=0; seq:=(seq+1) MOD 64; makepacket(ascb,seq,0) END; state:=wexit END; { Receive states PROCEDURES } PROCEDURE rcvinitiate; BEGIN IF rcvtyp=ascs THEN BEGIN getpar; {Get parameters from packet} putpar; {Put parameters into buffer} makepacket(ascy,seq,filbuf.ln); {Make ACK packet with our parameters} seq:=rcvseq; numtry:=0; seq:=(seq+1) MOD 64; state:=rheader END END; PROCEDURE rcvheader; BEGIN IF rcvtyp=ascf THEN BEGIN IF fnlen=0 THEN BEGIN { USE REMOTE FILE NAME } buftolin(rcvbuf,fname,fnlen); END; IF fnlen>0 THEN BEGIN { GOT A FILE TO RECEIVE TO - OPEN IT } wrtopn; IF wstatus=open THEN BEGIN makepacket(ascy,seq,0); numtry:=0; seq:=(seq+1) MOD 64; headok:=true; state:=rdata END ELSE error('ERROR OPENING WRITE FILE ') END ELSE error('NO OUTPUT FILE SPECIFIED ') END ELSE IF rcvtyp=ascb THEN BEGIN makepacket(ascy,seq,0); sndpkt; state:=cexit END ELSE IF rcvtyp=ascg THEN BEGIN makepacket(ascy,seq,0); { ACKNOWLEDGE } numtry:=0; gencmd(rcvbuf) { PROCESS GENERIC KERMIT CMD } END ELSE error('WRONG PACKET RECEIVING FILE HEADER ') END; PROCEDURE receivedata; BEGIN IF rcvtyp=ascd THEN BEGIN IF headok THEN { LAST PACKET - FILE HEADER WAS ACKed } BEGIN receiving:=true; { START RECEIVING FILE } headok:=false; { RESET HEADER FLAG } bsbuf:= 'RECEIVING FILE: '; writdev(ts,true,17,location(bsbuf)); FOR k:=1 TO rfnlen DO bsbuf[k]:=rfname[k+1]; writdev(ts,true,rfnlen,location(bsbuf)); ssbuf:=' ==> '; writdev(ts,true,5,location(ssbuf)); FOR k:=1 TO fnlen DO bsbuf[k]:=fname[k+1]; writdev(ts,true,fnlen,location(bsbuf)); tcbuf:=crlf; writdev(ts,true,2,location(tcbuf)) END; putrec(rcvbuf); makepacket(ascy,seq,0); numtry:=0; seq:=(seq+1) MOD 64 END ELSE IF rcvtyp=ascz THEN { RECEIVED EOF INDICATOR PACKET } BEGIN wrtcls; fnlen:=0; makepacket(ascy,seq,0); numtry:=0; seq:=(seq+1) MOD 64; state:=rheader END ELSE error('UNEXPECTED PACKET RECEIVING DATA ') END; PROCEDURE get; { PREPARE AN R PACKET } BEGIN IF rcvtyp=ascy THEN BEGIN { I PACKET ACKed - CONTINUE NEXT STATE } lintobuf(rfname,rfnlen,filbuf); { SEND FILE NAME TO GET } numtry:=0; makepacket(ascr,seq,filbuf.ln); state:=rinitiate END END; PROCEDURE iinitiate; BEGIN putpar; {Put parameters into buffer} makepacket(asci,seq,filbuf.ln); { MAKE I PARAMETER PACKET } numtry:=0 END; PROCEDURE finish; { SHUT DOWN REMOTE SERVER AND KERMIT } BEGIN bufinit(filbuf); putbuf(filbuf,ascf); makepacket(ascg,seq,filbuf.ln); {Make packet with our parameters} numtry:=0; state:=wexit END; PROCEDURE bye; { SHUT DOWN REMOTE SERVER, KERMIT & LOGOFF } BEGIN bufinit(filbuf); putbuf(filbuf,ascl); makepacket(ascg,seq,filbuf.ln); {Make packet with our parameters} numtry:=0; state:=wexit END; PROCEDURE connect; { CONNECT TO REMOTE } { THE PROCEDURE CONNECT IS A SIMPLE TTY TYPE EMULATOR USED TO } { CONNECT REMOTE SYSTEMS OR MODEMS. FULL DUPLEX I/O IS EMULATED. } { I/O IS ACCOMPLISHED VIA SVC CALLS. CALLS TO PROCEDURES TO PER- } { FORM READS AND WRITES HAVE BEEN REMOVED FOR GREATER SPEED - } { ESPECIALLY NEEDED FOR CHARACTER INPUT. A WAIT ON ANY I/O } { CALL IS MADE WHEN NOTHING IS GOING ON - TO AVOID SPINNING. } { IF WE GET AN INPUT BUFFER OVERFLOW(I.E. THE CHARACTERS ARE COM- } { ING IN FASTER THAN WE CAN HANDLE THEM),THEN WE WILL DYNAMICALLY } { ADJUST OUR XOFF THRESHOLD(I.E. NUMBER OF CHARACTERS TO RECEIVE } { AT ONE TIME BEFORE SENDING AN XOFF) TO ADAPT TO THE SYSTEM. } VAR escseq:boolean; { ESCAPE FROM REMOTE HOST } xbuf:char2; { XON - XOFF CHAR BUFFER } fq,bq:integer; { CHAR POINTERS } xoff:boolean; { XOFF-XON IN PROGRESS } wrt:boolean; { WRITE TO TERMINAL IS TAKING PLACE } b:boolean; { DOUBLE BUFFER POINTER } bufp:ARRAY[boolean]OF buf; { REMOTE CONNECT DOUBLE BUFFERS } justread:char; { FOR ECHO CHAR CONTROL } ti:integer; { GET CHAR LOOP CONTROLLER } dummy:char2; { JUNK TO SATISFY A WRITE NEED } adjustxoff:integer; { CURRENT NO. OF CHARS TO RECEIVE BEFORE XOFF } inesc:integer; { CHEAP EMULATOR FLAG } seqnum:integer; { HOW MANY ESQ SEQ. CHARS TO THROW AWAY FOR ISC } twochar:boolean; { DOUBLE CHAR FLAG } BEGIN seqnum:=0; inesc:=0; { NO VALID CHARACTER TO OUTPUT } twochar:=false; { NO 2 CHAR SEQUENCE TO SEND YET } adjustxoff:=xoff_threshold; { SET INITIAL VALUE } bq:=0; fq:=0; w1.op:= #36; { SET WAIT ON ANY I/O COMPLETION SVC OPCODE } w1.fil1:=0; { CLEAR REST OF CALLBLOCK } w1.fil2:=0; w1.fil3:=0; dummy:='#08#08'; xbuf:='#13#11'; { XOFF AND XON FOR I/O CONTROL } xoff:=false; wrt:=false; b:=true; escseq:=false; ti:=0; ps.subop:=readas; { READ ASCII SUBOPCODE } ps.flags:=[qret]; { QUICK RETURN I/O } ps.buf:=location(pcbuf); { SET BUFFER } ps.lrl:=1; { READ A SINGLE CHARACTER } svc$(location(ps)); { PERFORM I/O OPERATION } ts.subop:=readas; { READ ASCII SUBOPCODE } ts.flags:=[qret]; { QUICK RETURN I/O } ts.buf:=location(tcbuf); { SET BUFFER } ts.lrl:=1; { READ A SINGLE CHARACTER } svc$(location(ts)); { PERFORM I/O OPERATION } { UNTIL ESCAPE SEQ IS TYPED } WHILE NOT escseq AND ts.stat=0 AND (ps.stat=0 OR (ps.stat>=#50 AND ps.stat<=#52)) DO BEGIN { PARITY,FRAME,OVERFLOW - NON-FATAL } IF ps.stat>=#50 AND ps.stat<=#52 THEN BEGIN { NOT FATAL - i.e. HOPEFULLY THINGS WILL GET BETTER } IF ps.stat=#52 THEN BEGIN { OVERFLOW ERROR } IF lstatus=open THEN BEGIN writeln(lfile,'PORT FULL BUFFER ERROR'); writeln(lfile,'CHARS BUFFED SO FAR: ',fq) END; { ATTEMPT TO ADJUST XOFF THRESHOLD FOR CURRENT SYSTEM CONDITIONS } { BUT KEEP ABOVE MINIMUM TO AVOID XOFFING EVERY LINE OR TWO. } { ADJUSTING XOFF THRESHOLD IS EXPERIMENTAL AND MAY BE REMOVED } IF fq>200 AND fq '#1B' THEN bufp[b,fq]:=pcbuf[1] ELSE BEGIN inesc:=1; fq:=pred(fq) { THROW AWAY ESCAPE CHAR } END; 1: BEGIN inesc:=2; { ASSUME >2 SEQ LENGTH } { DEPENDING ON THE ESQ SEQ IDENTIFIER, NUMBER OF CHARS TO TOSS IS SET } CASE pcbuf[1] OF 'V': seqnum:=1; 'Y': BEGIN { DO A CRLF ON A CURSOR POSITION SEQUENCE } seqnum:=2; bufp[b,fq]:='#0A'; fq:=succ(fq); bufp[b,fq]:='#0D'; fq:=succ(fq) END; '4': seqnum:=1; '@': seqnum:=2; '>': seqnum:=2; 'j':seqnum:=2; 'x': seqnum:=4; '?': seqnum:=3; 'k': seqnum:=2 OTHERWISE { JUST TOSS THIS ONE i.e. 2 CHAR SEQ } inesc:=0 { AND RETURN TO NORMAL CHAR STATE } END; fq:=pred(fq) { TOSS THE CHAR } END; 2: BEGIN seqnum:=pred(seqnum); { SET NUMBER OF CHARS REMAINING TO TOSS } fq:=pred(fq); { TOSS THIS ONE } IF seqnum=0 THEN { ALL DONE TOSSING } inesc:=0 { RETURN TO NORMAL INPUT STATE } END END ELSE (******************************************************************) bufp[b,fq]:=pcbuf[1]; { SAVE CHAR - DOUBLE BUF } IF fq>adjustxoff THEN BEGIN { READ BUF ALMOST FULL } ps.subop:=writas; { WRITE ASCII SUBOPCODE } ps.flags:=[]; ps.buf:=location(xbuf); { POINT TO XOFF } ps.cc:=1; { CHARACTERS TO WRITE } svc$(location(ps)); { SEND XOFF } ps.subop:=readas; { READ ASCII SUBOPCODE } ps.flags:=[qret]; { QUICK RETURN I/O } ps.buf:=location(pcbuf); { SET BUFFER } ps.lrl:=1; { READ A SINGLE CHARACTER } IF ps.stat=0 THEN svc$(location(ps)); { NOW EMPTY PDT BUF } WHILE fq0 AND NOT wrt AND bsy IN ts.flags AND (bsy IN ps.flags OR xoff) THEN BEGIN IF fq>80 THEN BEGIN { LIMITED TO 80 CHAR WRITE WITH PASSTHRU } bq:=fq-80; fq:=80 END; abort(ts); ts.subop:=writas; { WRITE ASCII SUBOPCODE } ts.flags:=[qret]; { QUICK RETURN I/O } ts.cc:=fq; { CHARACTERS TO WRITE } ts.buf:=location(bufp[b]); { SET WRITE BUFFER } IF isc THEN { SPECIAL CHARACTER HANDLING } BEGIN IF fq=1 AND bufp[b,1]=justread THEN { THIS IS WHERE WE CAN SUPPRESS ECHO ON ISC } ts.buf:=location(dummy) { OR NON-PASSTHRU TERM } ELSE { ONLY UPPERCASE ON ISC ALLOWED } FOR i:=1 TO (bq+fq) DO { L.C. --> U.CASE } IF bufp[b,i]>='a' AND bufp[b,i]<='z' THEN bufp[b,i]:=chr(ord(bufp[b,i])-32) END; svc$(location(ts)); { PERFORM I/O OPERATION } wrt:=true; b:=NOT b; { ENABLE DOUBLE BUFFERING } fq:=0 END ELSE IF NOT(wrt OR bsy IN ts.flags OR ts.stat<>0)AND (bsy IN ps.flags OR xoff) THEN BEGIN { READ A CHAR FROM THE TERMINAL } IF ts.cc=1 THEN BEGIN justread:=tcbuf[1]; { SAVE LAST CHAR READ FROM TERM } IF tcbuf[1]='#40' OR tcbuf[1]='#5E' OR tcbuf[1]='#25' THEN BEGIN { SPECIAL CHARACTERS } tcbuf[2]:=tcbuf[1]; { SAVE POSSIBLE SPECIAL START CHAR } svc$(location(ts)); { TRY FOR SPECIAL SEQUENCE } delay(200); { ALLOW DELAY FOR REST OF SEQ } IF NOT bsy IN ts.flags AND ts.stat=0 THEN BEGIN { GOT ANOTHER CHAR } IF tcbuf='#40#40' THEN escseq:=true { GET OUT } ELSE { IF ON ISC(NO-PASSTHRU TERM) THE FOLLOWING KEY SEQUENCES ARE NEEDED } { IN ORDER TO SEND SPECIAL CONTROL KEYS TO TI REMOTE 931 PORT } IF tcbuf='#5E#5E' THEN BEGIN twochar:=true; { A TWO CHAR SEND } tcbuf:='#1B#68' { CMD KEY } END ELSE IF tcbuf='#25#25' THEN BEGIN twochar:=true; { A TWO CHAR SEND } tcbuf:='#1B#67' { BLNK ORGE KEY } END ELSE IF tcbuf='#5E#40' THEN tcbuf[1]:='#1B' { ESQ KEY } ELSE IF tcbuf='#25#40' THEN tcbuf[1]:='#11' { SEND XON } END END END ELSE IF isc THEN { ONLY FOR ISC TERMINAL } BEGIN tcbuf:=crlf; { HEURISTIC-PROBABLY A CR } ts.subop:=writas; ts.flags:=[]; ts.cc:=1; ts.buf:=location(tcbuf)+1; svc$(location(ts)) { WRITE LF TO ISC } END; IF NOT escseq AND NOT xoff AND ts.stat=0 THEN BEGIN abort(ps); ps.subop:=writas; { WRITE ASCII SUBOPCODE } ps.flags:=[]; IF isc AND twochar THEN BEGIN twochar:=false; { RESET } ps.cc:=2 { WRITE 2 CHARS } END ELSE ps.cc:=1; { CHARACTERS TO WRITE } ps.buf:=location(tcbuf); { SET BUFFER } svc$(location(ps)); { PERFORM I/O OPERATION } IF ps.stat=0 THEN BEGIN { CONTINUE - NO ERROR } ps.subop:=readas; { READ ASCII SUBOPCODE } ps.flags:=[qret]; { QUICK RETURN I/O } ps.buf:=location(pcbuf); { SET BUFFER } ps.lrl:=1; { READ A SINGLE CHARACTER } svc$(location(ps)); { PERFORM I/O OPERATION } IF NOT bsy IN ts.flags AND ts.stat=0 THEN BEGIN { READ POSSIBLY QUEUED ALREADY ABOVE } ts.subop:=readas; { READ ASCII SUBOPCODE } ts.lrl:=1; { READ A SINGLE CHAR } ts.flags:=[qret]; { QUICK RETURN I/O } ts.buf:=location(tcbuf); { SET BUFFER } svc$(location(ts)) { PERFORM I/O OPERATION } END END END END ELSE IF wrt AND NOT bsy IN ts.flags AND ts.stat=0 AND (bsy IN ps.flags OR xoff) THEN BEGIN IF bq>0 THEN BEGIN ts.subop:=writas; { WRITE ASCII SUBOPCODE } ts.flags:=[qret]; { QUICK RETURN I/O } ts.buf:=ts.buf+80; { SET BUFFER } IF bq>80 THEN BEGIN ts.cc:=80; bq:=bq-80 END ELSE BEGIN ts.cc:=bq; bq:=0 END; svc$(location(ts)) END ELSE BEGIN wrt:=false; ts.subop:=readas; { READ ASCII SUBOPCODE } ts.flags:=[qret]; { QUICK RETURN I/O } ts.buf:=location(tcbuf); { SET BUFFER } svc$(location(ts)); { PERFORM I/O OPERATION } IF xoff THEN BEGIN IF lstatus=open THEN writeln(lfile,'XOFF BEING RESET'); xoff:=false; pcbuf[1]:=xbuf[2]; IF bsy IN ps.flags THEN abort(ps); ps.subop:=writas; { WRITE ASCII SUBOPCODE } ps.flags:=[]; ps.buf:=location(pcbuf); { SET BUFFER } ps.cc:=1; { CHARACTERS TO WRITE } svc$(location(ps)); { PERFORM I/O OPERATION } IF ps.stat=0 THEN ps.subop:=readas; { READ ASCII SUBOPCODE } ps.flags:=[qret]; { QUICK RETURN I/O } ps.lrl:=1; { READ A SINGLE CHARACTER } svc$(location(ps)) { PERFORM I/O OPERATION } END END END END; IF bsy IN ps.flags AND bsy IN ts.flags AND bq=0 AND fq=0 AND NOT wrt AND NOT xoff THEN { NOTHING GOING ON } svc$(location(w1)) { DONT SPIN - WAIT ANY I/O COMPLETION } END; IF ts.stat<>0 AND lstatus=open THEN BEGIN writeln(lfile,'A TERMINAL SVC ERROR.'); writeln(lfile,'THE SVC ERROR IS: ',ts.stat hex); writeln(lfile,'BYE') END; IF ps.stat<>0 AND lstatus=open THEN BEGIN writeln(lfile,'A REMOTE PORT SVC ERROR.'); writeln(lfile,'THE SVC ERROR IS: ',ps.stat hex); writeln(lfile,'BYE') END END; { CONNECT } PROCEDURE help; BEGIN { HELP } tcbuf:=crlf; writdev(ts,true,2,location(tcbuf)); bsbuf:='THE FOLLOWING COMMANDS ARE SUPPORTED.#0D#0A '; writdev(ts,true,40,location(bsbuf)); bsbuf:='PLEASE USE UPPERCASE FOR ALL COMMANDS.#0D#0A'; writdev(ts,true,40,location(bsbuf)); writdev(ts,true,2,location(tcbuf)); bsbuf:='LOG #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='CONNECT - CONNECT TO REMOTE SYSTEM. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='SEND #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='RECEIVE #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='FINISH - SHUT DOWN REMOTE KERMIT. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='BYE - SHUT DOWN AND LOG OFF REMOTE. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='TEST - SEND ONLY TEST MODE. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='EXIT - LEAVE KERMIT. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='SERVER - PLACE KERMIT IN SERVER MODE. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='BINARY - SEND/RECEIVE BINARY FILE. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='TEXT - SEND/RECEIVE TEXT FILE(DEFAULT)#0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='GET #0D#0A'; writdev(ts,true,40,location(bsbuf)); writdev(ts,true,2,location(tcbuf)); writdev(ts,true,2,location(tcbuf)) END; { HELP } PROCEDURE error; { Error processing - Process fatal errors } VAR l:integer; BEGIN { ERROR } l:=size(msg); IF l>maxbuf-6 THEN l:=maxbuf-6; bufinit(filbuf); FOR i:=1 TO 3 DO putbuf(filbuf,ascsp); {Make message readable in packet} FOR i:=1 TO l DO putbuf(filbuf,ord(msg[i])); FOR i:=1 TO 3 DO putbuf(filbuf,ascsp); {Make message readable in packet} makepacket(asce,seq,filbuf.ln); sndpkt; state:=cexit; { THEN EXIT BACK TO COMMAND MODE } IF local AND NOT server THEN { OUT ERROR TO CONSOLE TOO } BEGIN ssbuf:='#0D#0A#0D#0A '; writdev(ts,true,4,location(ssbuf)); writdev(ts,true,40,location(msg)); writdev(ts,true,4,location(ssbuf)) END END; { ERROR } PROCEDURE kermcommand; BEGIN { KERMCOMMAND } IF lstatus=open AND server THEN writeln(lfile,'IN SERVER MODE'); REPEAT rcvpkt; { GET A PACKET } IF rcvseq>-1 THEN { LEGAL PACKET RECEIVED } BEGIN IF rcvtyp=asci AND server THEN { RECEIVED INIT PARMS PACKET } BEGIN getpar; {Get parameters from packet} putpar; {Put parameters into buffer} seq:=rcvseq; makepacket(ascy,seq,filbuf.ln); {Make ACK packet with our parameters} sndpkt { AND SEND IT OFF } END ELSE IF rcvtyp=ascs THEN BEGIN { RECEIVED SEND-INIT PACKET } state:=rinitiate END ELSE IF rcvtyp=ascr AND server THEN BEGIN { RECEIVE A FILE REQUEST PACKET } IF fnlen=0 THEN BEGIN buftolin(rcvbuf,fname,fnlen) END; state:=sinitiate END ELSE IF rcvtyp=ascg AND server THEN BEGIN makepacket(ascy,seq,0); { ACKNOWLEDGE } numtry:=0; gencmd(rcvbuf) { PROCESS GENERIC KERMIT COMMAND } END ELSE error('UNEXPECTED PACKET TYPE ') END ELSE IF rcvseq=-1 THEN BEGIN makepacket(ascn,seq,0); sndpkt { SEND PERIODIC NAK } END ELSE IF rcvseq=-2 THEN BEGIN state:=cexit; server:=false END UNTIL state<>kcommand END; PROCEDURE kerminitialize; { Initialization state } VAR lstat: boolean; BEGIN state:=kcommand; numtry:=0; seq:=0; fnlen:=0; {Indicate no file name yet} rfnlen:=0; { NO REMOTE FILE NAME YET } pktsnt:=0; { NUMBER OF PACKETS SENT } sending:=false; receiving:=false; { NOT RECEIVING A FILE YET } locbsiz:=78; loctout:=12; locnpad:=0; locpad:=0; loceol:=asccr; locquo:=ascns; { locqu8 will be set after options are processed. } locrep:=asctil; {Initialize to 0 to turn off repeat counts} rembsiz:=78; { remdsiz:=rembsiz-3; } remdsiz:=rembsiz-6; { MAKE SMALLER - EXCEEDING REMOTE BUFS } remtout:=12; remnpad:=0; rempad:=0; remeol:=asccr; remqu8:=0; remrep:=0; headok:=false; { NO HEADER PACKET YET } bptr:=0; { NO DATA IN BINARY DATA BUFFER YET } bufinit(sndbuf); {The following should only be done on the first call to initialize} IF iniflg=false THEN BEGIN sndonly:=false; sndlog:=false; rcvlog:=false; wrtlog:=false; redlog:=false; lnlen:=0; { LOG FILE LENGTH } crlfeol:=true; creol:=false; lfeol:=false; rstatus:=closed; wstatus:=closed; lstatus:=closed; eolflg:=false; { NO CR OR LF ENCOUNTERED YET } server:=false; { SET ONLY IN SERVER MODE } cond:=false; optqu8:=0; { ASSUME NO EIGHT-BIT QUOTING } binary:=false { DEFAUTLT NON-BINARY TYPE DATA } END; locqu8:=optqu8; { EIGHT BIT QUOTING DONE ONLY WITH BINARY OPTION } iniflg:=true END; PROCEDURE getstr(VAR wp,strlen:integer;VAR str:flen;cnt:boolean); (****************************************************************** * ATTEMPT TO GET A THE NEXT STRING WITHIN THIS BUFFER OF STRINGS * * WP - CURRENT CHAR POINTER WITHIN THE BUFFER * STRLEN - LENGTH OF THE STRING RETURNED - 0 IF NONE OR PAST END. * STR - THE ACTUAL STRING * CNT - IF TRUE PUT THE COUNT AT FRONT OF STRING - NEEDED FOR * FILE NAMES. ********************************************************************) BEGIN { GETSTR } strlen:=0; { CLEAR --> NO VALID STRING YET } WHILE cmdbuf.ch[wp]<>ascsp AND wp <=cmdbuf.ln DO wp:=succ(wp); { SKIP PAST CHARS IF ANY } WHILE cmdbuf.ch[wp]=ascsp AND wp <=cmdbuf.ln DO wp:=succ(wp); { SKIP PAST BLANKS BETWEEN STRINGS IF ANY } WHILE cmdbuf.ch[wp]<>ascsp AND wp<=cmdbuf.ln DO BEGIN { SAVE THE STRING WE ARE NOW POINTING TO } strlen:=succ(strlen); { SAVE LENGTH OF STRING } str[strlen]:=chr(cmdbuf.ch[wp]); { MOVE A CHAR } wp:=succ(wp) { BUMP BUFFER POINTER } END; IF strlen > 0 THEN { STRING IS VALID } BEGIN IF cnt THEN { WE NEED STRING COUNT AT FRONT } BEGIN FOR i:= (strlen+1) DOWNTO 2 DO str[i]:=str[(i-1)]; { SHIFT STRING ONE TO RIGHT } str[1]:=chr(strlen) { PUT STRING LENGTH AT FRONT OF STRING } END END END; { GETSTR } PROCEDURE prscmd(VAR parseok:boolean); { PARSE A KERMIT COMMAND } VAR sp:integer; { A STRING(cmdbuf) POINTER } BEGIN sp:=1; { POINT TO THE BEGINNING OF THE CMDBUF } (******************** SEND ********************) IF (cmdbuf.ch[1]=ascs AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=ascn) THEN BEGIN { THIS IS A SEND COMMAND } getstr(sp,fnlen,fname,true); { GET FILE NAME TO SEND - IF ANY } IF fnlen = 0 THEN BEGIN { SEND FILE NAME NOT IN CMD BUF - PROMPT USER } bsbuf:='FILE NAME SPECIFICATIONS WERE NOT ENTERE'; writdev(ts,true,40,location(bsbuf)); bsbuf:='D - TRY AGAIN PLEASE.#0D#0A '; writdev(ts,true,23,location(bsbuf)) END ELSE BEGIN parseok:=true; { CMD ENTERED SYNTACTICALLY OK } state:=sinitiate; { SET SEND INIT STATE } getstr(sp,rfnlen,rfname,true) { CHK FOR REMOTE FILENAME IN CMD } { A REMOTE FILE NAME IS OPTIONAL } END END; (****************** RECEIVE *******************) IF (cmdbuf.ch[1]=ascr AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=ascc) THEN BEGIN { THIS IS A RECEIVE COMMAND } getstr(sp,fnlen,fname,true); { GET LOCAL FILENAME TO STORE FILE UNDER } IF fnlen = 0 THEN BEGIN { REQUIRED RECEIVE FILE NAME NOT IN CMD BUF - PROMPT USER } bsbuf:='FILE NAME SPECIFICATIONS WERE NOT ENTERE'; writdev(ts,true,40,location(bsbuf)); bsbuf:='D - TRY AGAIN PLEASE.#0D#0A '; writdev(ts,true,23,location(bsbuf)) END ELSE BEGIN state:=rcv; { SET RCV STATE } parseok:=true { CMD ENTERED SYNTACTICALLY OK } END END; (******************** GET ********************) IF (cmdbuf.ch[1]=ascg AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=asct) THEN { THIS IS A GET COMMAND } BEGIN { EXTRACT FROM COMMAND LINE REMOTE FILE TO GET } getstr(sp,rfnlen,rfname,true); IF rfnlen = 0 THEN BEGIN { REMOTE FILE NAME TO GET NOT IN CMD LINE - PROMPT USER } bsbuf:='A REMOTE FILE NAME TO GET MUST BE ENTERE'; writdev(ts,true,40,location(bsbuf)); bsbuf:='D - TRY AGAIN PLEASE.#0D#0A '; writdev(ts,true,23,location(bsbuf)) END ELSE BEGIN getstr(sp,fnlen,fname,true); { LOCAL FILE NAME TO WRITE FILE TO } IF fnlen=0 THEN BEGIN { LOCAL FILE NAME TO WRITE REMOTE FILE TO NOT IN CMD LINE } bsbuf:='A LOCAL DX10 FILE NAME MUST BE ENTERED -'; writdev(ts,true,40,location(bsbuf)); bsbuf:= ' TRY AGAIN PLEASE.#0D#0A '; writdev(ts,true,20,location(bsbuf)) END ELSE BEGIN parseok:=true; { CMD ENTERED SYNTACTICALLY OK } iinitiate; { MAKE INITIAL I PACKET } state:=getinit { PREPARE R PACKET NEXT } END END END; (********************* LOG ********************) IF (cmdbuf.ch[1]=ascl AND cmdbuf.ch[2]=asco AND cmdbuf.ch[3]=ascg) THEN BEGIN { SET LOGGING } IF lstatus <> open THEN { NOT ALREADY OPEN } BEGIN getstr(sp,lnlen,lname,true); { GET USER LOG FILE - IF ANY } IF lnlen = 0 THEN { USE DEFAULT LOG FILE } p$parm(5,lname,perr); { GET DEFAULT LOG FILE PATHNAME } sndlog:=true; rcvlog:=true; wrtlog:=true; redlog:=true; logopn; parseok:=true { LOG COMMAND ACCEPTED CORRECT } END ELSE BEGIN bsbuf:='LOG FILE ALREADY OPEN - NO NEED TO SET L'; writdev(ts,true,40,location(bsbuf)); bsbuf:='OGGING AGAIN.#0D#0A '; writdev(ts,true,15,location(bsbuf)) END END; (******************** TEST ********************) IF (cmdbuf.ch[1]=asct AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=ascs) THEN BEGIN { SEND ONLY FOR TESTING } sndonly:=true; parseok:=true; { TEST COMMAND ACCEPTED CORRECT } bsbuf:='TEST MODE->NO PACKETS WILL BE RECEIVED#0D#0A'; writdev(ts,true,40,location(bsbuf)) END; (******************** SERVER ********************) IF (cmdbuf.ch[1]=ascs AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=ascr) THEN BEGIN { SEND ONLY FOR TESTING } server:=true; bsbuf:='#0D#0AKERMIT SERVER RUNNING ON DX10 HOST,#0D#0AP'; writdev(ts,true,40,location(bsbuf)); bsbuf:='LEASE TYPE YOUR ESC SEQUENCE TO RETURN#0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='TO YOUR LOCAL MACHINE. SHUT DOWN#0D#0ASERVE'; writdev(ts,true,40,location(bsbuf)); bsbuf:='R BY TYPING THE BYE OR FINISH COMMAND #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='ON YOUR LOCAL MACHINE.... #0D#0A'; writdev(ts,true,40,location(bsbuf)); parseok:=true; { SERVER CMD ACCEPTED } makepacket(ascn,seq,0); { SEND INITIAL NAK TO LOCAL } sndpkt { GET THINGS ROLLING } END; (******************** CONNECT ********************) IF (cmdbuf.ch[1]=ascc AND cmdbuf.ch[2]=asco AND cmdbuf.ch[3]=ascn) THEN BEGIN { CONNECT COMMAND } IF local THEN { CONNECT ONLY IN LOCAL MODE - PLEASE } BEGIN bsbuf:='#0D#0ACONNECTING THRU '; writdev(ts,true,18,location(bsbuf)); FOR k:=1 TO ord(ioname[1]) DO bsbuf[k]:=ioname[k+1]; writdev(ts,true,(ord(ioname[1])),location(bsbuf)); bsbuf:=', SPEED 1200#0D#0ATO ESCAPE AND RETURN TO YO'; writdev(ts,true,40,location(bsbuf)); bsbuf:='UR LOCAL #0D#0ASYSTEM - TYPE TWO "AT SIGN" '; writdev(ts,true,40,location(bsbuf)); bsbuf:=' @ #0D#0ACHARACTERS IN QUICK SEQUENCE. #0D#0A'; writdev(ts,true,40,location(bsbuf)); IF NOT isc THEN passt(ts,true) { SET PASSTHRU MODE WHILE CONNECTED TO REMOTE } ELSE { DISPLAY SPECIAL CHAR SEQUENCES FOR ISC } BEGIN tcbuf:=crlf; writdev(ts,true,2,location(tcbuf)); writdev(ts,true,2,location(tcbuf)); bsbuf:='TYPE THE FOLLOWING IN FAST SEQUENCE : #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='^ ^ (TWO UP ARROWS) FOR CMD KEY. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='% % (TWO PERCENTS) FOR BLNK ORNGE KEY.#0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='@ ^ ( AT SIGN AND UP ARROW) FOR ESQ. #0D#0A'; writdev(ts,true,40,location(bsbuf)); bsbuf:='@ % ( AT SIGN AND PERCENT) FOR DC1. #0D#0A'; writdev(ts,true,40,location(bsbuf)); writdev(ts,true,2,location(tcbuf)) END; IF ts.stat=0 THEN connect; { GO ATTEMPT CONNECT TO REMOTE } bsbuf:='#0A#0DKERMIT IS BACK TO LOCAL SYSTEM. #0D#0A'; writdev(ts,true,40,location(bsbuf)); IF ts.stat<>0 THEN BEGIN { CONSOLE TERMINAL I/O ERR DURING CONNECT } bsbuf:='CONSOLE TERMINAL ERROR DURING CONNECT.#0D#0A'; writdev(ts,true,40,location(bsbuf)) END; IF ps.stat<>0 THEN BEGIN { REMOTE PORT I/O ERROR DURING CONNECT } bsbuf:='REMOTE PORT I/O ERROR DURING CONNECT. #0D#0A'; writdev(ts,true,40,location(bsbuf)) END; IF NOT isc THEN { TURN OFF PASSTHRU } BEGIN { SO WE CAN DO CMD CONTROL AGAIN } IF bsy IN ts.flags THEN { ABORT ANY I/O FIRST } abort(ts); { OR PASSTHRU WON'T BE AFFECTED } passt(ts,false) { THEN TURN IT OFF } END; parseok:=true { ONLY ERR ON THIS COMMAND IS MISSPELLING } END ELSE BEGIN bsbuf:='#0D#0AYOU HAVE ALREADY CONNECTED TO A REMOTE'; writdev(ts,true,40,location(bsbuf)); bsbuf:='#0D#0ASYSTEM. USE YOUR ESCAPE SEQUENCE IF Y'; writdev(ts,true,40,location(bsbuf)); bsbuf:='OU #0D#0AWISH TO RETURN TO YOUR LOCAL SYSTEM'; writdev(ts,true,40,location(bsbuf)); bsbuf:='.#0D#0A '; writdev(ts,true,3,location(bsbuf)) END END; (******************** FINISH ********************) IF (cmdbuf.ch[1]=ascf AND cmdbuf.ch[2]=asci AND cmdbuf.ch[3]=ascn) THEN BEGIN { USER TYPED THE FINISH COMMAND } parseok:=true; { CMD ENTERED SYNTACTICALLY OK } iinitiate; { MAKE REQUIRED PRECEDING I PACKET } state:=fininit END; (******************** BYE ********************) IF (cmdbuf.ch[1]=ascb AND cmdbuf.ch[2]=ascy AND cmdbuf.ch[3]=asce) THEN BEGIN { USER TYPED THE BYE COMMAND } parseok:=true; { CMD ENTERED SYNTACTICALLY OK } iinitiate; { MAKE REQUIRED PRECEDING I PACKET } state:=byeinit END; (******************** SET-RESERVED FOR FUTURE*) IF (cmdbuf.ch[1]=ascs AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=asct) THEN BEGIN { SET A KERMIT PARAMETER } sp:=4; { WE GOT PAST SET } WHILE cmdbuf.ch[sp]=ascsp AND sp<30 DO sp:=succ(sp); { SKIP SPACES } parseok:=true; bsbuf:='SET COMMAND RESERVED FOR FUTURE USE. #0D#0A'; { YOU COULD PROBABLY IMPLEMENT SET BAUD , SET PARITY, ETC. HERE. } writdev(ts,true,40,location(bsbuf)) END; (******************** HELP ********************) IF (cmdbuf.ch[1]=asch AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=ascl) THEN BEGIN { USER WANTS HELP } help; { SO HELP USER } state:=cexit; parseok:=true { COMMAND PARSED OK } END; (******************** BINARY ********************) IF (cmdbuf.ch[1]=ascb AND cmdbuf.ch[2]=asci AND cmdbuf.ch[3]=ascn) THEN BEGIN { SET BINARY FILE TYPE } optqu8:=ascamp; { EIGHT-BIT QUOTING WILL BE DONE } crlfeol:=false; { NO CARRIAGE CON. IN BINARY FILES } binary:=true; { BINARY TYPE FILE TRANSFERS } bsbuf:='BINARY FILE - 8 BIT QUOTING TURNED ON.#0D#0A'; writdev(ts,true,40,location(bsbuf)); state:=cexit; parseok:=true { COMMAND PARSED OK } END; (********************** TEXT ********************) IF (cmdbuf.ch[1]=asct AND cmdbuf.ch[2]=asce AND cmdbuf.ch[3]=ascx) THEN BEGIN { SET TEXT FILE TYPE } optqu8:=0; { NO EIGHT-BIT QUOTING WILL BE DONE } crlfeol:=true; { SET CARRIAGE CONTROL ON } binary:=false; { NO BINARY FILE TYPE } bsbuf:='TEXT FILE TYPE TRANSFER TURNED ON. #0D#0A'; writdev(ts,true,40,location(bsbuf)); state:=cexit; parseok:=true { COMMAND PARSED OK } END; (********************* EXIT ********************) IF (cmdbuf.ch[1]=asce AND cmdbuf.ch[2]=ascx AND cmdbuf.ch[3]=asci) THEN BEGIN { SET PROPER EXIT FLAGS } server:=false; state:=kexit; parseok:=true { EXIT COMMAND ACCEPTED CORRECT } END; END; PROCEDURE getcmd; { INTERACTIVELY GET A USER COMMAND } VAR validcmd:boolean; BEGIN { GETCMD } validcmd:=false; tcbuf:=crlf; writdev(ts,true,2,location(tcbuf)); WHILE NOT validcmd DO BEGIN ssbuf:='KERMIT-990> '; { USER PROMPT- MODIFIABLE IN FUTURE } writdev(ts,true,12,location(ssbuf)); bufinit(cmdbuf); { CLEAR THE COMMAND BUFFER } IF local THEN BEGIN ts.lrl:=size(cmdbuf.ch); { SIZE OF BUF FOR READ } readdev(ts,true,location(cmdbuf.ch)); cmdbuf.ln:=ts.cc; { GET ACTUAL SIZE OF CMD READ } ssbuf:='#0D#0A '; { JUST CRLF FOR OTHERS } writdev(ts,true,2,location(ssbuf)) END ELSE { PORT IS IN PASSTHRU MODE SO READ ONE CHAR AT A TIME } BEGIN ineoln:=false; { NOT END OF CMD YET } WHILE NOT ineoln DO { CMD ENDS WITH RETURN } BEGIN readdev(ts,true,location(tcbuf)); { GET A CHAR } IF tcbuf[1]='#0D' THEN BEGIN tcbuf:=crlf; { ECHO PROPER CARRIAGE CONTROL } writdev(ts,true,2,location(tcbuf)); ineoln:=true { ACCEPT AND PARSE CMD } END ELSE IF tcbuf[1]='#08' THEN BEGIN IF cmdbuf.ln>=1 THEN { BS IS LEGAL } BEGIN ssbuf:='#08 #08 '; { THIS IS A BS? - ALMOST! } writdev(ts,true,3,location(ssbuf)); cmdbuf.ch[cmdbuf.ln]:=ascsp; { BLANK POSITION IN CMD BUF } cmdbuf.ln:=pred(cmdbuf.ln) END END ELSE BEGIN writdev(ts,true,1,location(tcbuf)); { ECHO CHAR } cmdbuf.ch[(cmdbuf.ln+1)]:=ord(tcbuf[1]); { SAVE CHAR } IF cmdbuf.ch[1] <> ascsp THEN { IGNORE LEAD SPACES } cmdbuf.ln:=succ(cmdbuf.ln) { INC CHAR COUNT } END END END; IF cmdbuf.ln >1 THEN { WE HAVE ACTUAL CMD TO PARSE } BEGIN prscmd(validcmd); { PARSE THE COMMAND } IF NOT validcmd THEN { PARSE FAILURE --> CMD SYNTAX ERR } BEGIN bsbuf:='INCORRECT OR NON-SUPPORTED COMMAND: '; writdev(ts,true,38,location(bsbuf)); FOR i:=1 TO cmdbuf.ln DO BEGIN tcbuf[1]:=chr(cmdbuf.ch[i]); writdev(ts,true,1,location(tcbuf)) { DISPLAY BAD CMD } END; tcbuf:='#0D#0A'; writdev(ts,true,2,location(tcbuf)) END END END END; { GETCMD } { ************************* Main block **************************** } BEGIN { KERMIT } { LET'S TAKE CARE OF SOME STANDARD FILE I/O INITIALIZATION } p$parm(6,ioname,perr); { GET MY STATUS LOCAL OR REMOTE } local:=ioname[2]='L'; p$parm(7,ioname,perr); { CHECK FOR SPECIAL ISC TERMINAL } isc:=ioname[2]='I' AND local; IF local AND NOT isc THEN { THIS BLOCK IS OPTIONAL } BEGIN { DONT TRY TO CLEAR SOME REMOTE TERMINAL } initscreen(blk,lun); { ENABLE DISPLAY-ACCEPT FOR CLEARS } clearscreen(blk) { CLEAR THE SCREEN } END; p$parm(3,ioname,perr); { GET REMOTE PORT NAME } p$parm(4,tname,perr); { MY TERMINAL NAME } initio(location(tname),ts); { OPEN CONSOLE TERMINAL } initio(location(ioname),ps); { OPEN REMOTE PORT AND SET PASSTHRU } IF ps.stat=0 AND ts.stat=0 THEN { PORTS READY FOR I/O } BEGIN { NORMAL KERMIT PROCESSING } ssbuf:='#0D#0A#0D#0A '; writdev(ts,true,2,location(bsbuf)); bsbuf:='WELCOME TO DX10 KERMIT-990 - RELEASE 1.0'; writdev(ts,true,40,location(bsbuf)); bsbuf:= '#0D#0A '; writdev(ts,true,2,location(bsbuf)); bsbuf:='TYPE HELP TO VIEW THE KERMIT COMMANDS.#0D#0A'; writdev(ts,true,40,location(bsbuf)); iniflg:=false; { FOR ONCE ONLY VAR INITS } state:=kcommand; WHILE server OR state<>kexit DO BEGIN kerminitialize; { KCOMMAND MAY BE A GOOD CHOICE FOR SERVER MODE } WHILE NOT server AND state=kcommand DO getcmd; IF state=rcv THEN state:=kcommand; { FALL BACK TO CMD MODE AFTER RCV } IF state=kcommand THEN kermcommand; IF state=sinitiate THEN sendinitiate; IF state=rinitiate THEN rcvinitiate; WHILE state<>cexit AND state<>kexit DO BEGIN { PACKET SENDING STATE } REPEAT sndpkt; numtry:=numtry+1; IF sndonly THEN BEGIN rcvseq:=seq; rcvtyp:=ascy; rcvbuf.ln:=0 END ELSE BEGIN rcvpkt END; IF rcvtyp=ascn THEN BEGIN { RECEIVED NAK } rcvseq:=(rcvseq-1) MOD 64; rcvtyp:=ascy END UNTIL (rcvseq=seq) OR (numtry>=maxtry) OR (state= kexit) OR (state = cexit); IF (rcvseq<>seq) AND (state<>kexit) THEN error('DIDNT RECEIVE EXPECTED PACKET ') ELSE IF rcvtyp=asce THEN {Just received error packet} BEGIN state:=wexit END ELSE BEGIN CASE state OF getinit:get; sheader :sendheader; sdata :senddata; sbreak :sendbreak; rinitiate:rcvinitiate; rheader :rcvheader; rdata :receivedata; wexit:state:=cexit; { ALLOWS LAST SNDPKT } fininit:finish; { BUILD FINISH PACKET } byeinit:bye; { BUILD BYE PACKET } kexit :; cexit: END END END; wrtcls END; logcls; { CLOSE LOG FILE IF OPEN } bsbuf:='KERMIT END.#0D#0AHAVE A HOPPY HAPPY DAY!!!#0D#0A'; writdev(ts,true,40,location(bsbuf)) END ELSE IF ts.stat=0 THEN { TERMINAL OK TO OUTPUT PORT ERR TO } BEGIN bsbuf:='KERMIT PORT OPEN FAILED - TRY AGAIN.#0D#0A#0D#0A'; writdev(ts,true,40,location(bsbuf)) END END. { KERMIT }