Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / archives / tandem.zip / tandem.tal < prev next >

Wrap

Text File | 1988-08-16 | 40KB | 1,360 lines

?NOCODE ?INSPECT DEFINE VERSTRING = "Tandem KERMIT server - Version 1.0"#; !*****************************************************************************! !* *! !* TANDEM KERMIT SERVER *! !* VERSION 1.0 *! !* MARCH 6, 1986 *! !* *! !* PROGRAMMER: CHARLES J. CANTOR *! !* CANTOR CONSULTING *! !* 116 DICKERMAN RD. *! !* NEWTON, MA 02161 *! !* *! !* Revision history (newest to oldest): *! !* VERSION DATE BY/DESCRIPTION *! !* 1.0 03/06/86 A. G. Camas (Bedford, MA) - Added "[NO]BREAK" *! !* option. Added handling for "I" (initialize) *! !* packet now used before server is asked to send. *! !* Made fancier "banner" with version number. *! !* *! !* 0.0 11/01/84 Charles J. Cantor (Cantor Consulting, Newton, MA) *! !* - Original version of software. *! !* *! !* *! !* This server will send and receive ASCII files only. *! !* The output file will be an EDIT file. *! !* *! !* THE FOLLOWING HAVE NOT BEEN IMPLEMENTED: *! !* Generic commands other than LOGOFF (Hangs up Modem). *! !* Host commands. *! !* Wild carding. *! !* *! !* Repeat counts have only been unit tested. *! !* *! !* Eight bit quoting is implemented in the send and receive procs. *! !* The EDIT file implementation appends <cr><lf> to output *! !* lines and strips them on input, rendering the issue moot; *! !* therefore, it has been defaulted out and also butchered out in *! !* PROC PROCESS^SEND^INIT *! !* *! !* COMPILATION: *! !* TAL /IN KERMITS,OUT $S.#KERM/KERMIT *! !* *! !* USAGE: *! !* *! !* RUN KERMIT <option-list> *! !* *! !* Where <option-list> consists of a series of options separated *! !* by commas. *! !* *! !* OPTION: DEFAULT: *! !* *! !* [NO]DEBUG NODEBUG *! !* [NO]TABS TABS *! !* [NO]TRUNC NOTRUNC *! !* [NO]FLIP NOFLIP *! !* [NO]PURGE NOPURGE *! !* [NO]BREAK BREAK *! !* *! !* Specifying DEBUG allows non-protocol interaction at a *! !* terminal, i. e. no <soh>'s are sent or expected and no *! !* checksumming of input is done. *! !* *! !* Unless NOTABS is specified, tabs will be expanded to spaces *! !* on input. Tab stops are the usual every 8'th column. No tab *! !* expansion is done on output. *! !* *! !* TRUNC will truncate file-specs at the first decimal point on *! !* send requests, e. g. SEND KERMIT.A86 will go to TANDEM file *! !* KERMIT. *! !* *! !* FLIP will flip file.ext in send requests. *! !* SEND KERMIT.A86 will go to TANDEM file <vol>.A86.KERMIT. *! !* *! !* PURGE will purge existing files on send requests. *! !* *! !* If you specify NOBREAK, interruption by the BREAK key is *! !* disabled. On some noisy lines, this can help since line *! !* noise is sometimes seen as BREAK, which interrupts the server. *! !* NOBREAK should not be a problem, since ctrl/Y stops KERMIT. *! !* *! !* THE SERVER WILL ACCEPT AND PARSE FILE SPECS GENERATED BY: *! !* *! !* SEND local-file-spec[~tandem-file-spec] *! !* GET tandem-file-spec[~local-file-spec] *! !* *! !* The SERVER will return the local-file-spec on a receive *! !* (default is tandem-file-spec), e.g. *! !* KERMIT-86>GET DOCUMENT.KERPROTO~KERPROTO.DOC *! !* *! !* Changes would have to be made to local KERMITs to implement *! !* the augmentation of the SEND command. *! !* *! !* IDIOSYNCRACIES: *! !* Trailing blanks are trimmed on input. *! !* It is a good idea to run the server from a command file: *! !* :RUN KERMIT *! !* :INITTERM *! !* as the SETMODES leave the terminal in a strange state if *! !* it aborts. *! !* *! !* RUNNING ON LINES GENNED FOR 6530's WITHOUT 6530 EMULATION: *! !* The TANDEM generates "go into conversational mode" sequences *! !* (<soh>C<etx><LRC>) from time to time. ACK (<ctrl-F>) them. *! !* *! !* It also generates an <enq> (<ctrl-E>) from time to time when *! !* sending large amounts of data to the terminal. Any character *! !* takes care of them; however, an ACK is expected and will not be *! !* echoed. The TANDEM will eventually time out and continue output *! !* in any case. *! !* *! !* Avoid block mode (e.g. XVS) like the plague. *! !* *! !* EXITING THE SERVER: *! !* <ctry-y> at terminal emulation level exits the server. *! !* *! !*****************************************************************************! ?PAGE "GLOBALS" ?NOLIST,SOURCE $SYSTEM.SYSTEM.GPLDEFS ?LIST ?PAGE LITERAL SOH = 1, ETX = 3, TAB = %11, CR = %15, LF = %12, CTRL^Y = %31, TRUE = -1, FALSE = 0; DEFINE LEGAL^PACKETS^D(INIT) = STRING LEGAL^PACKETS ='P' := [INIT,0]; STRING .POINTER; INT N#, CHECK^LEGAL^D = SCAN LEGAL^PACKETS UNTIL PACKET^TYPE -> @POINTER; N := @POINTER '-' @LEGAL^PACKETS#, BAD^PACKET^D = BEGIN PACKET^TYPE := -1; RETURN; END#, CLOSE^FILE^D(FCB) = BEGIN IF FILE^OPEN^FLAG THEN BEGIN CALL CLOSE^FILE(FCB); FILE^OPEN^FLAG := FALSE; END; END#, ERROR^MESSAGE^D(A) = BEGIN IN^BUF^S ':=' A & 0; CALL ERROR^PACKET(,IN^BUF^S); END#, NOT^IMPL^D = ERROR^MESSAGE^D("Command not implemented")#, NO^PROC(A) = PROC A; BEGIN END#, I^NO^PROC(A) = INT PROC A; BEGIN RETURN TRUE; END#; STRUCT PARAMS(*); BEGIN STRING BUFSIZ; STRING TIMOUT; STRING NPAD; STRING PAD^CHAR; STRING EOL; STRING QUOTE^CHAR; STRING EIGHT^BIT; STRING CHECK^TYPE; STRING REPEAT^CHAR; STRING RESERVED[0:1]; END; DEFINE CHAR(X) = ((X) + " ")#, UNCHAR(X) = ((X) - " ")#, CTL(X) = ((X) XOR %100)#, CHKSUM(X) = (((X) + ((X) '>>' 6)) LAND %77)#, SIX^BIT(X) = ((X) LAND %77)#, MARK = SOH#; STRING .IN^BUF^S[0:511], !LINE BUFFER! .FILE^BUF^S[0:4095]; !FILE BLOCK BUFFER! STRING .OUT^PACKET[0:99],SAVE^SUM; INT OUT^PACKET^LENGTH,IN^PACKET^LENGTH; INT .IN^BUF := @IN^BUF^S '>>' 1, .FILE^BUF := @FILE^BUF^S '>>' 1; INT DEBUG^FLAG := FALSE, REPEAT^FLAG, MAX^DATA^CHARS, TABS^FLAG := TRUE; INT FLIP^FLAG := FALSE, INIT^FAILED := FALSE, TRUNC^FLAG := FALSE; INT PURGE^FLAG := FALSE; INT BREAK^FLAG := TRUE; INT FILE^OPEN^FLAG := FALSE; INT .OLD^BREAK[0:1]; !SAVES PREVIOUS BREAK DATA IF NOBREAK MODE! STRING .SBUF[0:511]; !SCRATCH BUFFER AND FILE I/O BUFFER! INT .BUF := @SBUF '>>' 1; LITERAL OUT^BLKLEN = 4096; ALLOCATE^CBS(RUCB,COMMON^FCB,3); ALLOCATE^FCB(IN^FCB," #IN "); ALLOCATE^FCB(FILE^FCB," JUNK "); !PICK UP DEFAULT! ALLOCATE^FCB(ERR^FCB," #TERM "); INT .DEFAULT^VOL[0:7]; INT .FILE^NAME; INT .TERM^NAME; INT .ERR^NAME; INT TERMNUM; INT .FILENUM; STRING PACKET^TYPE; STRING .DEFAUL[0:$LEN(PARAMS) - 1] := [ CHAR(94), !MAX BUFSIZE! CHAR(5), !TIME OUT! CHAR(0), !NUMBER OF PAD CHARS! CTL(0), !PAD CHARACTER! CHAR(CR), !END OF LINE CHARACTER! "#", !CONTROL QUOTE! "N", !8 BIT QUOTE! "1", !CHKSUM TYPE! "~", !REPEAT QUOTER! " "]; !RESERVED! STRING .MY^PARAM^STRING[0:$LEN(PARAMS) - 1]; STRING .HIS^PARAM^STRING[0:$LEN(PARAMS) - 1]; STRING .MY^PARAMS(PARAMS) := @MY^PARAM^STRING; STRING .HIS^PARAMS(PARAMS) := @HIS^PARAM^STRING; INT WAIT^FOREVER, MAX^RETRIES := 5, NUM^RETRIES := 0; INT(32) TIME^OUT; STRING PACKET^NUMBER := 0, INPUT^PACKET^NUMBER := 0; STRUCT START^MSG^DEF(*); BEGIN INT MSGCODE; STRUCT DEFAULT; BEGIN INT VOLUME[0:3]; INT SUBVOL[0:3]; END; STRUCT INFILE; BEGIN INT VOLUME[0:3]; INT SUBVOL[0:3]; INT DNAME[0:3]; END; STRUCT OUTFILE; BEGIN INT VOLUME[0:3]; INT SUBVOL[0:3]; INT DNAME[0:3]; END; STRING PARAM[0:596]; END; ?NOLIST,SOURCE $SYSTEM.SYSTEM.EXTDECS ?LIST ?PAGE "FORWARDS" PROC GET^PACKET(RETRIES) VARIABLE; INT RETRIES; FORWARD; PROC ERROR^PACKET(ERROR,MESSAGE) VARIABLE; INT ERROR; STRING .MESSAGE; FORWARD; ?PAGE "START^PROC" PROC START^PROC (RUCB,PASSTHRU,MESSAGE,MESLEN,MATCH) VARIABLE; ! THIS PROC PARSES THE PARAMS PORTION OF THE START UP MESSAGE! INT .RUCB,.PASSTHRU,MESLEN,MATCH; STRUCT .MESSAGE(START^MSG^DEF); BEGIN INT DONE := FALSE,MATCHED; STRING .MES^S,.TEMP; DEFINE MATCH^IT(A,FLAG) = BEGIN IF MES^S = "NO" AND MES^S[2] = A THEN BEGIN MATCHED := TRUE; FLAG := FALSE; END; IF MES^S = A THEN BEGIN MATCHED := TRUE; FLAG := TRUE; END; END#; @MES^S := @MESSAGE '<<' 1; MES^S[MESLEN] := 0; @MES^S := @MES^S[$OFFSET(MESSAGE.PARAM)]; CALL SHIFTSTRING(MES^S,MESLEN - $OFFSET(MESSAGE.PARAM),0); !UPPER CASE! WHILE NOT DONE DO BEGIN SCAN MES^S WHILE " " -> @MES^S; !STRIP LEADING BLANKS! SCAN MES^S UNTIL "," -> @TEMP; IF $CARRY THEN BEGIN DONE := TRUE; IF @MES^S = @TEMP THEN RETURN; MATCHED := FALSE; END; MATCH^IT("TABS",TABS^FLAG); MATCH^IT("DEBUG",DEBUG^FLAG); MATCH^IT("PURGE",PURGE^FLAG); MATCH^IT("TRUNC",TRUNC^FLAG); MATCH^IT("FLIP",FLIP^FLAG); MATCH^IT("BREAK",BREAK^FLAG); IF NOT MATCHED THEN BEGIN INIT^FAILED := TRUE; DONE := TRUE; END; @MES^S := @TEMP[1]; END; RETURN; END; ?PAGE "MISCELLANEOUS SERVICE PROCS" INT PROC CHECKSUMMER(POINTER,LENGTH); ! THIS PROC COMPUTES THE CHECKSUMS FOR BOTH INBOUND AND OUT BOUND PACKETS! ! IT RETURNS THE LENGTH OF THE PACKET ! ! LENGTH ON INPUT IS THE ACTUAL LENGTH: SOH -> CHECKSUM! STRING .POINTER; INT LENGTH; BEGIN INT N,TEMP,TEMP1 := 0; SAVE^SUM := POINTER[LENGTH - 1]; TEMP := 0; FOR N := 1 TO LENGTH - 2 DO BEGIN TEMP1.<8:15> := POINTER[N].<8:15>; TEMP := TEMP + TEMP1; END; POINTER[LENGTH - 1] := CHAR(CHKSUM(TEMP.<8:15>)); POINTER[LENGTH] := UNCHAR(HIS^PARAMS.EOL); IF POINTER[LENGTH] = 0 THEN RETURN LENGTH ELSE RETURN LENGTH + 1; END; PROC FINISH^AND^SHIP(LENGTH,RETRIES) VARIABLE; ! THIS PROC WILL COMPLETE THE SENDING OF A GENERAL DATA PACKET AND RETRIEVE ! THE REPLY. THE PACKET IS EXPECTED IN OUT^PACKET. ! LENGTH IS THE LENGTH OF THE DATA IN THE PACKET, I.E. THE CHARACTERS AFTER ! PACKET TYPE BYTE. INT LENGTH,RETRIES; BEGIN IF NOT $PARAM(LENGTH) THEN LENGTH := 0; IF NOT $PARAM(RETRIES) THEN RETRIES := MAX^RETRIES; LENGTH := LENGTH + 3; OUT^PACKET[1] := CHAR(LENGTH); LENGTH := LENGTH + 2; PACKET^NUMBER := SIX^BIT(INPUT^PACKET^NUMBER + 1); OUT^PACKET[2] := CHAR(PACKET^NUMBER); OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,LENGTH); CALL GET^PACKET; RETURN; END; ?PAGE PROC ERROR^PACKET(ERROR,MESSAGE) VARIABLE; ! THIS PROC SENDS AN ERROR PACKET. IF IT IS CALLED WITH AN ERROR PARAMETER, ! IT ASSUMES A FILE ERROR AND FORMATS AN APPROPRIATE MESSAGE ! IF ITS IS CALLED WITH A MESSAGE, IT ASSUMES THAT SHOULD BE SENT INT ERROR; STRING .MESSAGE; BEGIN INT LENGTH; STRING .FILE^ERROR[0:19] := " FILE ERROR: "; OUT^PACKET ':=' [MARK,"LNE"]; LENGTH := 0; IF $PARAM(ERROR) THEN BEGIN CALL NUMOUT(FILE^ERROR[14],ERROR,10,3); OUT^PACKET[4] ':=' FILE^ERROR FOR 20; LENGTH := 20; END; IF $PARAM(MESSAGE) THEN BEGIN SCAN MESSAGE UNTIL 0 -> LENGTH; LENGTH := LENGTH '-' @MESSAGE; OUT^PACKET[4] ':=' MESSAGE FOR LENGTH; END; INPUT^PACKET^NUMBER := 77; CALL FINISH^AND^SHIP(LENGTH,2); PACKET^TYPE := -1; END; INT PROC OPEN^INPUT^FILE; BEGIN INT ERROR; CALL SET^FILE(FILE^FCB,ASSIGN^OPENACCESS, READ^ACCESS); ERROR := OPEN^FILE(COMMON^FCB,FILE^FCB,FILE^BUF,OUT^BLKLEN, ,ABORT^OPENERR+ABORT^XFERERR+AUTO^CREATE); IF ERROR = 0 THEN BEGIN FILE^OPEN^FLAG := TRUE; RETURN TRUE; END; CALL ERROR^PACKET(ERROR); RETURN FALSE; END; INT PROC OPEN^OUTPUT^FILE; BEGIN INT ERROR; INT(32) FLAGS := AUTO^CREATE; IF PURGE^FLAG THEN FLAGS := FLAGS + PURGE^DATA ELSE FLAGS := FLAGS + MUSTBENEW; CALL SET^FILE(FILE^FCB,ASSIGN^OPENACCESS, WRITE^ACCESS); ERROR := OPEN^FILE(COMMON^FCB,FILE^FCB,FILE^BUF,OUT^BLKLEN, FLAGS, ABORT^OPENERR+ABORT^XFERERR+AUTO^CREATE+PURGE^DATA+MUSTBENEW); IF ERROR = 0 THEN BEGIN FILE^OPEN^FLAG := TRUE; RETURN TRUE; END; CALL ERROR^PACKET(ERROR); RETURN FALSE; END; INT PROC WRITE^OUTPUT^FILE(LENGTH); INT LENGTH; BEGIN INT ERROR; ERROR := WRITE^FILE(FILE^FCB,BUF,LENGTH); IF ERROR = 0 THEN RETURN TRUE; CALL ERROR^PACKET(ERROR); RETURN FALSE; END; PROC GIVE^IT^UP(HANG^UP) VARIABLE; INT HANG^UP; ! THIS IS THE CLEAN UP AND EXIT PROC. ! IT IS CALLED WHEN THE MAX RETRY COUNT IS EXCEEDED OR AN UNRECOVERABLE ! ERROR OCCURS ON THE LINE ! IF THE HANG UP IS INCLUDED, IT ALSO HANGS UP THE MODEM BEGIN CLOSE^FILE^D(FILE^FCB); CALL CLOSE(TERMNUM); CALL OPEN(TERM^NAME,TERMNUM); !REOPEN WAITED! CALL SETMODE(TERMNUM,28,0); IF NOT BREAK^FLAG THEN CALL SETMODE(TERMNUM,11,OLD^BREAK[0], OLD^BREAK[1]); !RESET BREAK TO CI! IF $PARAM(HANG^UP) THEN CALL CONTROL(TERMNUM,12); !HANG UP! CALL STOP; END; ?PAGE "PROC INITIALIZE" PROC INITIALIZE; BEGIN INT FLAG := 0,ERROR; SBUF ':=' [5,"INPUT"]; CALL SET^FILE(IN^FCB,ASSIGN^LOGICALFILENAME,@BUF); SBUF ':=' [6,"OUTPUT"]; CALL SET^FILE(FILE^FCB,ASSIGN^LOGICALFILENAME,@BUF); SBUF ':=' [5,"ERROR"]; CALL SET^FILE(ERR^FCB,ASSIGN^LOGICALFILENAME,@BUF); CALL INITIALIZER(RUCB,,START^PROC); @TERM^NAME := CHECK^FILE( IN^FCB, FILE^FILENAME^ADDR); @FILE^NAME := CHECK^FILE(FILE^FCB, FILE^FILENAME^ADDR); @ERR^NAME := CHECK^FILE(ERR^FCB, FILE^FILENAME^ADDR); DEFAULT^VOL ':=' FILE^NAME FOR 8; FLAG.<3:5> := 0; !READ WRITE! FLAG.<8> := 1; !NOWAIT! FLAG.<12:15> := 7; !MAX-CONCURRENT NOWAIT IO! CALL SET^FILE(ERR^FCB,ASSIGN^OPENACCESS, WRITE^ACCESS); CALL OPEN^FILE(COMMON^FCB,ERR^FCB,,, PURGE^DATA !FLAGS!,PURGE^DATA !MASK!,!LEN!,!PROMPT!,ERR^FCB); CALL OPEN(TERM^NAME,TERMNUM); !OPEN WAITED TO DO THE SETMODES! IF <> THEN CALL DEBUG; IF INIT^FAILED THEN BEGIN SBUF ':=' "PARAMETER ERROR, KERMIT ABORTED" -> ERROR; CALL WRITE(TERMNUM,BUF,ERROR - @SBUF); CALL STOP; END; SBUF ':=' VERSTRING -> ERROR; CALL WRITE(TERMNUM,BUF,ERROR - @SBUF); SBUF ':=' "Use CTRL/Y to exit" -> ERROR; CALL WRITE(TERMNUM,BUF,ERROR - @SBUF); MY^PARAMS ':=' DEFAUL FOR $LEN(PARAMS); HIS^PARAMS ':=' MY^PARAMS FOR $LEN(PARAMS); MY^PARAMS.TIMOUT := CHAR(0); ERROR := 0; ERROR.<8:15> := UNCHAR(HIS^PARAMS.TIMOUT); TIME^OUT := $DBLL(0,100*ERROR); IF DEBUG^FLAG THEN RETURN; SBUF ':=' [CTRL^Y,CTRL^Y,CTRL^Y,CR]; !EOF & CR ONLY INTERRUPT CHARACTERS! CALL SETMODE(TERMNUM,9,BUF,BUF[1]); !SET LINE TERMINATION! CALL SETMODE(TERMNUM,10,0); !NO-PARITY CHECKING! CALL SETMODE(TERMNUM,6,0); !NO SPACE! CALL SETMODE(TERMNUM,7,0); !NO LINE FEED AFTER CR! CALL SETMODE(TERMNUM,20,0); !NO-ECHO! !If NOBREAK mode, disable break and save old break parameters IF NOT BREAK^FLAG THEN CALL SETMODE(TERMNUM,11,0,0,OLD^BREAK); CALL CLOSE(TERMNUM); !CLOSE AND CALL OPEN(TERM^NAME,TERMNUM,FLAG); !RE-OPEN NO WAIT! IF <> THEN CALL DEBUG; RETURN; END; ?PAGE "ACK AND NAK FORMATTING PROCS" PROC FORMAT^ACK; BEGIN PACKET^NUMBER := INPUT^PACKET^NUMBER; OUT^PACKET ':=' [MARK,CHAR(3),0,"Y",0]; OUT^PACKET[2] := CHAR(PACKET^NUMBER); OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,5); RETURN; END; PROC FORMAT^NAK; BEGIN OUT^PACKET ':=' [MARK,CHAR(3),0,"N",0]; OUT^PACKET[2] := CHAR(PACKET^NUMBER); OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,5); RETURN; END; ?PAGE "PROC GET^PACKET" PROC GET^PACKET(RETRIES) VARIABLE; ! THIS IS THE LOW LEVEL LINE MANAGEMENT PROTOCOL PROC ! INT RETRIES; BEGIN STRING NON^FATALS = 'P' := [40,120,140,0]; INT COUNT,ERROR,MODEM^TRIES := 0; INT SUBPROC PAD^PACKET; ! THIS PADS AND MOVES THE OUTPUT PACKET FORM OUT^PACKET TO THE ! LINE BUFFER BEGIN STRING PAD^CHAR; INT N; PAD^CHAR := UNCHAR(HIS^PARAMS.PAD^CHAR); N := UNCHAR(HIS^PARAMS.NPAD); IF N <> 0 THEN IN^BUF^S ':=' PAD^CHAR FOR 1 & IN^BUF^S FOR N - 1; IF DEBUG^FLAG THEN BEGIN OUT^PACKET^LENGTH := OUT^PACKET^LENGTH; OUT^PACKET ':=' OUT^PACKET[1] FOR OUT^PACKET^LENGTH - 1 & LF; !STRIP MARK! END; IN^BUF^S[N] ':=' OUT^PACKET FOR OUT^PACKET^LENGTH; RETURN N + OUT^PACKET^LENGTH; END; INT SUBPROC VALID^MESSAGE; BEGIN INT LENGTH := 0; !THIS SUBPROC VALIDITY CHECKS THE INCOMING MESSAGE! ! SCAN FOR MARK AND SHIFT MESSAGE TO BEGINNING OF BUFFER! IF DEBUG^FLAG THEN !ACCEPT INPUT FROM TERMINAL FOR DEBUGGING! BEGIN PACKET^TYPE := IN^BUF^S; IN^PACKET^LENGTH := COUNT - 1; IN^BUF^S ':=' IN^BUF^S[1] FOR IN^PACKET^LENGTH & 0; IF PACKET^TYPE <> "Y" AND PACKET^TYPE <> "N" THEN INPUT^PACKET^NUMBER := PACKET^NUMBER + 1 ELSE INPUT^PACKET^NUMBER := PACKET^NUMBER; RETURN TRUE; END; WHILE LENGTH < COUNT AND IN^BUF^S[LENGTH] <> MARK DO LENGTH := LENGTH + 1; COUNT := COUNT - LENGTH; IF COUNT < 5 THEN RETURN FALSE; !MARK & LENGTH & SEQ & TYPE & CHECKSUM! IF LENGTH <> 0 THEN IN^BUF^S ':=' IN^BUF^S[LENGTH] FOR COUNT; LENGTH := 0; LENGTH.<8:15> := UNCHAR(IN^BUF^S[1]) + 2; IF LENGTH > COUNT THEN RETURN FALSE; CALL CHECKSUMMER(IN^BUF^S,LENGTH); IF SAVE^SUM <> IN^BUF^S[LENGTH - 1] THEN RETURN FALSE; INPUT^PACKET^NUMBER := UNCHAR(IN^BUF^S[2]); PACKET^TYPE := IN^BUF^S[3]; IN^PACKET^LENGTH := LENGTH - 5; !TYPE, SEQ, CHECKSUM, MARK, LENGTH IN^BUF^S ':=' IN^BUF^S[4] FOR IN^PACKET^LENGTH & 0; RETURN TRUE; END; ?PAGE IF $PARAM(RETRIES)THEN NUM^RETRIES := RETRIES ELSE NUM^RETRIES := MAX^RETRIES; WHILE WAIT^FOREVER OR NUM^RETRIES <> 0 DO BEGIN CALL WRITEREAD(TERMNUM,IN^BUF,PAD^PACKET,512,COUNT); IF NOT DEBUG^FLAG THEN CALL AWAITIO(TERMNUM,!BUFFER!,COUNT,,TIME^OUT); CALL FILEINFO(TERMNUM,ERROR); IF ERROR = 120 THEN ERROR := 0; !PARITY! IF ERROR <> 0 THEN BEGIN IF ERROR = 40 THEN !TIME^OUT! BEGIN IF NOT WAIT^FOREVER THEN NUM^RETRIES := NUM^RETRIES - 1; END; IF ERROR = 140 THEN !MODEM ERROR! BEGIN MODEM^TRIES := MODEM^TRIES + 1; IF MODEM^TRIES > MAX^RETRIES THEN BEGIN CALL CONTROL(TERMNUM,12); !DISCONNECT MODEM! CALL GIVE^IT^UP; END ELSE CALL DELAY(100D); !WAIT 1! END; SCAN NON^FATALS UNTIL ERROR.<8:15>; IF $CARRY THEN CALL GIVE^IT^UP; !FATAL! END ! I/O ERROR! ELSE !NO I/O ERROR! BEGIN IF VALID^MESSAGE THEN IF PACKET^TYPE <> "Y" THEN BEGIN IF PACKET^TYPE <> "N" THEN RETURN; ! GOT A NAK, SEE IF IT WAS FOR NEXT PACKET! IF SIX^BIT(PACKET^NUMBER + 1) = INPUT^PACKET^NUMBER THEN !NAK FOR PACKET N + 1 IS EQUIVALENT TO ACK OF N! BEGIN PACKET^TYPE := "Y"; INPUT^PACKET^NUMBER := PACKET^NUMBER; RETURN; END; END ELSE !ACK! IF INPUT^PACKET^NUMBER = PACKET^NUMBER THEN RETURN; IF NOT WAIT^FOREVER THEN NUM^RETRIES := NUM^RETRIES - 1; END; END; !LOOP! PACKET^TYPE := -1; RETURN; END; ?PAGE "PROC PROCESS^SEND^INIT" PROC PROCESS^SEND^INIT(IN^PARAMS,TYPE,LENGTH); ! THIS PROC DOES THE HOUSEKEEPING ASSOCIATED WITH SEND INIT MESSAGES ! AND SEND INIT ACKS ! IT WILL FORMAT THE MESSAGE INTO OUT^PACKET WITH TYPE "Y" OR "S" ! DEPENDING ON THE INPUT PARAMETER ! STRING .IN^PARAMS(PARAMS),TYPE; INT LENGTH; BEGIN INT N; STRING .OUT^PARAMS(PARAMS) := @OUT^PACKET[4]; STRING SAVE^REPEAT; CALL FORMAT^ACK; OUT^PACKET[3] := TYPE; IN^PARAMS.CHECK^TYPE := "1"; IN^PARAMS.EIGHT^BIT := "N"; OUT^PARAMS ':=' IN^PARAMS FOR LENGTH & DEFAUL[LENGTH] FOR $LEN(PARAMS) - LENGTH; SAVE^REPEAT := OUT^PARAMS.REPEAT^CHAR; FOR N := 0 TO $LEN(PARAMS) - 1 DO IF OUT^PACKET[N + 4] = " " THEN OUT^PACKET[N + 4] := DEFAUL[N]; OUT^PARAMS.REPEAT^CHAR := SAVE^REPEAT; HIS^PARAMS ':=' OUT^PARAMS FOR $LEN(PARAMS); IF HIS^PARAMS.EIGHT^BIT <> "Y" THEN BEGIN OUT^PARAMS.EIGHT^BIT := "Y"; OUT^PARAMS.EIGHT^BIT := "N"; !REMOVE IF YOUR KERMIT WORKS! END ELSE BEGIN OUT^PARAMS.EIGHT^BIT := MY^PARAMS.EIGHT^BIT; HIS^PARAMS.EIGHT^BIT := MY^PARAMS.EIGHT^BIT; END; REPEAT^FLAG := (HIS^PARAMS.REPEAT^CHAR <> " "); MAX^DATA^CHARS := 91; IF HIS^PARAMS.BUFSIZ <> " " THEN MAX^DATA^CHARS := UNCHAR(HIS^PARAMS.BUFSIZ) - 3; LENGTH := $LEN(PARAMS) + 5; OUT^PACKET[1] := CHAR(LENGTH - 2); OUT^PACKET^LENGTH := CHECKSUMMER(OUT^PACKET,LENGTH); RETURN; END; ?PAGE "NON IMPLEMENTED" PROC COMMAND^PROC; BEGIN NOT^IMPL^D; RETURN; END; PROC GENERIC^PROC; BEGIN IF IN^BUF^S = "L" THEN BEGIN MAX^RETRIES := 2; CALL FORMAT^ACK; CALL GET^PACKET; CALL GIVE^IT^UP(TRUE); END; NOT^IMPL^D; RETURN; END; ?PAGE "PROC RECEIVE PROC" INT PROC RECEIVE^PROC; ! IN BOUND FILE PROC ! BEGIN LEGAL^PACKETS^D("BSFDZ"); INT OUT^COUNT, !INPUT PARSING STUFF! LF^WAIT := FALSE, WRITE^IT^OUT := FALSE; STRING CHRSAV,CHR; LITERAL MAX^BUF^SIZE = 132; SUBPROC PARSE^FILE^HEADER; BEGIN INT NAME^LENGTH; STRING .IN^POINTER; RSCAN IN^BUF^S[IN^PACKET^LENGTH -1] WHILE "~" -> @IN^POINTER; IN^PACKET^LENGTH := @IN^POINTER[1] '-' @IN^BUF^S; IF IN^PACKET^LENGTH <= 0 THEN BEGIN CALL ERROR^PACKET(999); !ERROR! RETURN; END; IN^POINTER[1] := 0; SCAN IN^BUF^S UNTIL "~" -> @IN^POINTER; IF NOT $CARRY THEN BEGIN NAME^LENGTH := IN^PACKET^LENGTH '-' (@IN^POINTER[1] '-' @IN^BUF^S); IN^BUF^S ':=' IN^POINTER[1] FOR NAME^LENGTH & 0; END ELSE BEGIN !NOT A SUPPLIED NAME, PLAY WITH REMOTE NAME! NAME^LENGTH := IN^PACKET^LENGTH; SCAN IN^BUF^S UNTIL "." -> @IN^POINTER; IF NOT $CARRY THEN BEGIN IF TRUNC^FLAG OR IN^POINTER[1] = 0 THEN IN^POINTER := 0; IF FLIP^FLAG AND IN^POINTER <> 0 THEN BEGIN IN^POINTER := 0; SBUF ':=' IN^BUF^S FOR NAME^LENGTH; IN^BUF^S ':=' IN^POINTER[1] FOR NAME^LENGTH; SCAN IN^BUF^S UNTIL 0 -> @IN^POINTER; IN^POINTER ':=' "." & SBUF FOR NAME^LENGTH; END; END; END; CALL FNAMEEXPAND(IN^BUF,FILE^NAME,DEFAULT^VOL); RETURN; END; !SUBPROC! SUBPROC GET^NEXT^CHAR; BEGIN CHRSAV := 0; IF IN^BUF^S[N] = HIS^PARAMS.EIGHT^BIT AND HIS^PARAMS.EIGHT^BIT <> "N" THEN BEGIN !EIGHT BIT! N := N + 1; CHRSAV := %200; END; IF IN^BUF^S[N] = HIS^PARAMS.QUOTE^CHAR THEN BEGIN N := N + 1; CHR := IN^BUF^S[N]; IF (CHR = HIS^PARAMS.EIGHT^BIT AND HIS^PARAMS.EIGHT^BIT <> "N") OR (REPEAT^FLAG AND CHR = HIS^PARAMS.REPEAT^CHAR) OR CHR = HIS^PARAMS.QUOTE^CHAR THEN !TAKE IT AS LITERAL! CHRSAV := CHRSAV + CHR ELSE CHRSAV := CTL(CHRSAV + CHR); END ELSE CHRSAV := CHRSAV + IN^BUF^S[N]; N := N + 1; RETURN; END; INT SUBPROC PROCESS^OUTPUT^DATA; BEGIN INT REPEAT^COUNT := 0; N := 0; WHILE N < IN^PACKET^LENGTH OR REPEAT^COUNT <> 0 DO BEGIN IF OUT^COUNT >= MAX^BUF^SIZE OR WRITE^IT^OUT THEN IF NOT WRITE^OUTPUT^FILE(OUT^COUNT) THEN RETURN FALSE ELSE BEGIN OUT^COUNT := 0; WRITE^IT^OUT := FALSE; END; IF REPEAT^COUNT <> 0 THEN BEGIN SBUF[OUT^COUNT] := CHRSAV; OUT^COUNT := OUT^COUNT + 1; REPEAT^COUNT := REPEAT^COUNT - 1; END ELSE BEGIN !REPEAT COUNT EXHAUSTED, GET ANOTHER CHARACTER! CHR := IN^BUF^S[N]; IF NOT REPEAT^FLAG OR CHR <> HIS^PARAMS.REPEAT^CHAR THEN REPEAT^COUNT := 1 ELSE BEGIN REPEAT^COUNT := UNCHAR(IN^BUF^S[N+1]); N := N + 2; END; CALL GET^NEXT^CHAR; IF CHRSAV = LF AND LF^WAIT THEN BEGIN LF^WAIT := FALSE; REPEAT^COUNT := REPEAT^COUNT - 1; WRITE^IT^OUT := TRUE; END; IF LF^WAIT AND CHRSAV <> LF THEN BEGIN SBUF[OUT^COUNT] := CR; OUT^COUNT := OUT^COUNT + 1; LF^WAIT := FALSE; END; IF CHRSAV = CR THEN BEGIN REPEAT^COUNT := REPEAT^COUNT - 1; LF^WAIT := TRUE; END; IF CHRSAV = TAB AND TABS^FLAG THEN BEGIN REPEAT^COUNT := 8 * REPEAT^COUNT - (OUT^COUNT LAND 7); CHRSAV := " "; END; END; !NEW CHARACTER, REPEAT COUNT = 0! END; !LOOP! RETURN TRUE; END; !SUBPROC! SUBPROC RECEIVE^FILE^HEADER; BEGIN LEGAL^PACKETS^D("SZBF"); WHILE 1 DO BEGIN CHECK^LEGAL^D; CASE N OF BEGIN !0! BEGIN CALL PROCESS^SEND^INIT(IN^BUF^S,"YY",IN^PACKET^LENGTH); CALL GET^PACKET; END; !1! BEGIN !EOF! CALL FORMAT^ACK; CALL GET^PACKET; END; !2! RETURN; !BREAK! !3! BEGIN !FILE HEADER! CALL PARSE^FILE^HEADER; IF NOT OPEN^OUTPUT^FILE THEN BAD^PACKET^D; OUT^COUNT := 0; RETURN; END; OTHERWISE BAD^PACKET^D; END; !CASE! END; !LOOP! END; !SUBPROC! SUBPROC RECEIVE^DATA; BEGIN LEGAL^PACKETS^D("FZD"); WHILE 1 DO BEGIN CHECK^LEGAL^D; CASE N OF BEGIN !0! BEGIN !FILE HEADER! CALL FORMAT^ACK; CALL GET^PACKET; END; !1! BEGIN !EOF! IF OUT^COUNT <> 0 AND NOT WRITE^OUTPUT^FILE(OUT^COUNT) THEN BAD^PACKET^D; OUT^COUNT := 0; CLOSE^FILE^D(FILE^FCB); RETURN; END; !2! BEGIN !DATA PACKET! IF INPUT^PACKET^NUMBER <> PACKET^NUMBER THEN BEGIN !IF INCREMENT > 1, THINGS ARE FUBAR, SO PROCEED WITH DATA! IF NOT PROCESS^OUTPUT^DATA THEN BAD^PACKET^D; !HANDLES OWN ERRORS! END; CALL FORMAT^ACK; CALL GET^PACKET; RETURN; END; OTHERWISE BAD^PACKET^D; END; !CASE! END; !LOOP! END; !SUBPROC! WHILE 1 DO BEGIN CHECK^LEGAL^D; CASE N OF BEGIN !CASE 0 COMPLETE (BREAK)! BEGIN IF OUT^COUNT <> 0 THEN CALL WRITE^OUTPUT^FILE(OUT^COUNT); OUT^COUNT := 0; CLOSE^FILE^D(FILE^FCB); CALL FORMAT^ACK; CALL GET^PACKET; RETURN TRUE; END; !CASE 1! !SEND INIT! CALL RECEIVE^FILE^HEADER; !CASE 2! !FILE HEADER! CALL RECEIVE^DATA; !CASE 3! !DATA! CALL RECEIVE^DATA; !CASE 4! !EOF! CALL RECEIVE^FILE^HEADER; !ABORT! OTHERWISE RETURN FALSE; END; !CASE! END; !LOOP! END; !PROC! ?PAGE "PROC SEND^PROC" PROC SEND^PROC; !THIS PROC HANDLES OUT BOUND FILE TRANSFERS! BEGIN INT ERROR,.COUNT^READ[0:0],OUT^COUNT,MAX^COUNT,SHIP^FLAG; INT OUT^OF^INPUT := TRUE,DONE := FALSE; INT REPEAT^COUNT, EIGHT^BIT, CONTROL^CHAR, NEED^QUOTE, TOTAL^COUNT; STRING CHR; STRING .IN^POINTER,.OUT^POINTER; STRING .ECHO^FILE^NAME[0:39],.TEMP^NAME[0:39]; INT ECHO^NAME^LENGTH; INT REMAINING^CHARS,IN^COUNT; DEFINE CHECK^PACKET^D = IF PACKET^TYPE <> "Y" THEN BEGIN ERROR^MESSAGE^D("Gave up waiting for ACK"); RETURN; END#; INT SUBPROC PARSE^FILE^HEADER; BEGIN RSCAN IN^BUF^S[IN^PACKET^LENGTH -1] WHILE "~" -> @IN^POINTER; IN^PACKET^LENGTH := @IN^POINTER[1] '-' @IN^BUF^S; IF IN^PACKET^LENGTH <= 0 THEN BEGIN CALL ERROR^PACKET(11); !FILE NO EXIST! RETURN FALSE; END; IN^POINTER[1] := 0; SCAN IN^BUF^S UNTIL "~" -> @IN^POINTER; IF NOT $CARRY THEN BEGIN ECHO^NAME^LENGTH := IN^PACKET^LENGTH '-' (@IN^POINTER[1] '-' @IN^BUF^S); ECHO^FILE^NAME ':=' IN^POINTER[1] FOR ECHO^NAME^LENGTH; END ELSE BEGIN ECHO^NAME^LENGTH := IN^PACKET^LENGTH; ECHO^FILE^NAME ':=' IN^BUF^S FOR ECHO^NAME^LENGTH; END; CALL FNAMEEXPAND(IN^BUF,FILE^NAME,DEFAULT^VOL); RETURN TRUE; END; !SUBPROC! SUBPROC SET^UP^DATA; BEGIN OUT^COUNT := 0; OUT^PACKET ':=' [MARK,"LND"]; @OUT^POINTER := @OUT^PACKET[4]; SHIP^FLAG := FALSE; REMAINING^CHARS := MAX^DATA^CHARS; RETURN; END; !SUBPROC! SUBPROC GET^REPEAT(POINTER); STRING .POINTER; BEGIN STRING .LOCAL^POINTER; STRING CHR1; IF TOTAL^COUNT + 2 > REMAINING^CHARS THEN RETURN; IF COUNT^READ - IN^COUNT < 4 THEN RETURN; @LOCAL^POINTER := @POINTER[1]; CHR1 := POINTER; IN^COUNT := IN^COUNT + 1; !MUST SUBTRACT OFF LATER! WHILE CHR1 = LOCAL^POINTER[REPEAT^COUNT] AND IN^COUNT < COUNT^READ DO BEGIN IN^COUNT := IN^COUNT + 1; REPEAT^COUNT := REPEAT^COUNT + 1; END; IF REPEAT^COUNT < 3 THEN BEGIN !DON'T BOTHER! IN^COUNT := IN^COUNT - REPEAT^COUNT; REPEAT^COUNT := 0; END ELSE REPEAT^COUNT := REPEAT^COUNT + 1; IN^COUNT := IN^COUNT - 1; !COMPENSATE! END; INT SUBPROC FILL^IN^DATA; ! THIS IS THE MAIN INPUT AND OUTPUT BUFFERING SUBPROC ! BEGIN STRING REPEAT; WHILE REMAINING^CHARS > 0 DO BEGIN IF IN^COUNT = COUNT^READ THEN BEGIN OUT^OF^INPUT := TRUE; RETURN FALSE; END; REPEAT^COUNT := 0; EIGHT^BIT := 0; CONTROL^CHAR := 0; NEED^QUOTE := 0; CHR := SBUF[IN^COUNT]; IF ((CHR LAND %200) <> 0) AND HIS^PARAMS.EIGHT^BIT <> "N" THEN EIGHT^BIT := 1; CHR := CHR LAND %177; IF CHR < " " THEN BEGIN CHR := CTL(CHR); CONTROL^CHAR := 1; END; IF (REPEAT^FLAG AND CHR = HIS^PARAMS.REPEAT^CHAR) OR CHR = HIS^PARAMS.QUOTE^CHAR OR (HIS^PARAMS.EIGHT^BIT <> "N" AND CHR = HIS^PARAMS.EIGHT^BIT) THEN NEED^QUOTE := 1; TOTAL^COUNT := NEED^QUOTE + CONTROL^CHAR + EIGHT^BIT + 1; IF TOTAL^COUNT > REMAINING^CHARS THEN RETURN TRUE; !SHIP IT! IF REPEAT^FLAG THEN CALL GET^REPEAT(SBUF[IN^COUNT]); IF REPEAT^COUNT <> 0 THEN BEGIN REPEAT := CHAR(REPEAT^COUNT.<8:15>); TOTAL^COUNT := TOTAL^COUNT + 2; OUT^POINTER ':=' HIS^PARAMS.REPEAT^CHAR FOR 1 & REPEAT FOR 1 -> @OUT^POINTER; END; IF EIGHT^BIT <> 0 THEN OUT^POINTER ':=' HIS^PARAMS.EIGHT^BIT FOR 1 -> @OUT^POINTER; IF CONTROL^CHAR <> 0 THEN OUT^POINTER ':=' HIS^PARAMS.QUOTE^CHAR FOR 1 -> @OUT^POINTER; IF NEED^QUOTE <> 0 THEN OUT^POINTER ':=' HIS^PARAMS.QUOTE^CHAR FOR 1 -> @OUT^POINTER; !AND FINALLY THE CHARACTER! OUT^POINTER ':=' CHR FOR 1 -> @OUT^POINTER; IN^COUNT := IN^COUNT + 1; REMAINING^CHARS := REMAINING^CHARS - TOTAL^COUNT; OUT^COUNT := OUT^COUNT + TOTAL^COUNT; END; !WHILE LOOP ON FULL OUTPUT BUFFER! RETURN TRUE; !GO SHIP IT! END; !SUBPROC! IF NOT PARSE^FILE^HEADER THEN RETURN; IF NOT OPEN^INPUT^FILE THEN RETURN; CALL PROCESS^SEND^INIT(MY^PARAMS,"SS",$LEN(PARAMS)); MY^PARAMS ':=' DEFAUL FOR $LEN(PARAMS); !RESET DEFAULTS! CALL GET^PACKET; CHECK^PACKET^D; ! GOT SEND INIT REPLY, PROCESS IT. ! CALL PROCESS^SEND^INIT(IN^BUF^S,"YY",IN^PACKET^LENGTH); ! SET UP FILE HEADER ! OUT^PACKET ':=' [MARK,"LNF"] & ECHO^FILE^NAME FOR ECHO^NAME^LENGTH; CALL FINISH^AND^SHIP(ECHO^NAME^LENGTH); CHECK^PACKET^D; CALL SET^UP^DATA; !INITIALIZE OUTPUT STRUCTURE! WHILE NOT DONE DO BEGIN IF OUT^OF^INPUT THEN BEGIN ERROR := READ^FILE(FILE^FCB,BUF,COUNT^READ); IF ERROR = 1 THEN !EOF! BEGIN DONE := TRUE; IF OUT^COUNT <> 0 THEN SHIP^FLAG := TRUE; END ELSE IF ERROR <> 0 THEN BEGIN CALL ERROR^PACKET(ERROR); RETURN; END; IF ERROR = 0 THEN @IN^POINTER := @IN^BUF^S; OUT^OF^INPUT := FALSE; SBUF[COUNT^READ] ':=' [CR,LF]; COUNT^READ := COUNT^READ + 2; IN^COUNT := 0; END; WHILE NOT OUT^OF^INPUT DO IF SHIP^FLAG OR FILL^IN^DATA THEN BEGIN CALL FINISH^AND^SHIP(OUT^COUNT); CHECK^PACKET^D; CALL SET^UP^DATA; END; IF ERROR = 1 THEN BEGIN CLOSE^FILE^D(FILE^FCB); OUT^PACKET ':=' [MARK,"LNZ"]; !EOF PACKET! CALL FINISH^AND^SHIP(0); CHECK^PACKET^D; OUT^PACKET ':=' [MARK,"LNB"]; !BREAK PACKET! CALL FINISH^AND^SHIP(0); CHECK^PACKET^D; END; END; !LOOP! END; !PROC! ?PAGE "MAIN PROC" PROC KERMIT^SERVER MAIN; BEGIN LEGAL^PACKETS^D("SIRGCNYE"); INT DONT^NAK; CALL INITIALIZE; DONT^NAK := FALSE; WHILE 1 DO BEGIN IF DONT^NAK THEN DONT^NAK := FALSE ELSE CALL FORMAT^NAK; WAIT^FOREVER := TRUE; CALL GET^PACKET; CHECK^LEGAL^D; WAIT^FOREVER := FALSE; CASE N OF BEGIN !S! CALL RECEIVE^PROC; !I! BEGIN CALL PROCESS^SEND^INIT(IN^BUF^S,"YY",IN^PACKET^LENGTH); DONT^NAK := TRUE; END; !R! CALL SEND^PROC; !G! CALL GENERIC^PROC; !C! CALL COMMAND^PROC; !NAK! ; !ACK! ; !ERROR! ; OTHERWISE ERROR^MESSAGE^D("Unexpected Packet Received"); END; !CASE! CLOSE^FILE^D(FILE^FCB); END; !FOREVER LOOP! END;!MAIN!