home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
tandem
/
tandem.src
< prev
next >
Wrap
Text File
|
1997-11-12
|
40KB
|
1,412 lines
?NOCODE
?symbols
?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 *!
!* 2.0 ??/??/9? CAIL / John Deere Corp. *!
!* *!
!* 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];
STRING RESERVED[0:3];
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!
"Y", !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;
! 4/3/95 - do not trim for binary files
CALL SET^FILE(FILE^FCB,SET^READ^TRIM,0);
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);
CALL SET^FILE(FILE^FCB,ASSIGN^FILECODE,0);
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;
CALL SET^FILE(FILE^FCB,SET^WRITE^PAD,0);
! 4/3/95 - do not trim for binary files
CALL SET^FILE(FILE^FCB,SET^WRITE^TRIM,0);
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;
! 12/16/94 - trun off 'a' packet capability
! didn't seem to have any qffect on procomm - still got a packet
! accept 'A' packets
!OUT^PARAMS.RESERVED[0] := %h28 ;
! no capabilities
OUT^PARAMS.RESERVED[0] := %h20 ;
! sliding windows size
OUT^PARAMS.RESERVED[1] := %h20 ;
! extended packet size
OUT^PARAMS.RESERVED[2] := %h20 ;
OUT^PARAMS.RESERVED[3] := %h20 ;
!LENGTH := $LEN(PARAMS) + 5;
!LENGTH := $LEN(PARAMS) + 4;
! try 1 byte capabilities mask only
LENGTH := $LEN(PARAMS) + 5 - 3 ;
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;
INT 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;
! swallow change directory command
IF IN^BUF^S = "C" THEN
BEGIN
CALL FORMAT^ACK;
RETURN -1;
END;
NOT^IMPL^D;
RETURN 0;
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;
! 12/15/94 - only for text files
! 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");
LEGAL^PACKETS^D("SZBFA");
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;
!4! BEGIN !FILE ATTRIBUTES|
CALL FORMAT^ACK;
CALL GET^PACKET;
END;
OTHERWISE BAD^PACKET^D;
END; !CASE!
END; !LOOP!
END; !SUBPROC!
SUBPROC RECEIVE^DATA;
BEGIN
LEGAL^PACKETS^D("FZDA");
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;
!3! BEGIN !FILE ATTRIBUTES!
CALL FORMAT^ACK;
CALL GET^PACKET;
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;
! only for text files
!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! DONT^NAK := 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!