?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!
