XTKERM3.m

XTKERM3 ;SF/RWF - Kermit protocol Send/Receive packet ;8/19/92  11:19 ; [ 10/10/95  3:34 PM ]

 ;;7.3;TOOLKIT;;Apr 25, 1995

 ;Packet <Mark><Len><Seq><type><data><Check><Eol>

A ;Setup <Maxl><Timeout><Npad><Padc><Eol><Qctrl><Qbin>

RPACK ;Receive a packet

 S XTKERR=0,XTKR("PT")="A",XTKR("PN")=99,XTKRDAT="",XTKRPK="" F I=0:0 R A:XTKR("TO") G:'$T RTO X XTKR("TRMRD") Q:Y=XTKR("SOH")

 R XTKRPK:XTKR("TO") G RTO:'$T X XTKR("TRMRD") I Y=XTKR("SOH") S XTKERR="1 SOH in record" Q

 I $D(XTKDEBUG) S XTKDEBUG=XTKDEBUG+1,^TMP("XTKERM",$J,XTKDEBUG)="R:"_XTKRPK

RCK S L=$A(XTKRPK)-32,XTKR("PN")=$A(XTKRPK,2)-32,XTKR("PT")=$E(XTKRPK,3),XTKRDAT=$E(XTKRPK,4,L) I $L(XTKRPK)-1-L S XTKERR="3 Size error" Q

 S C=0 F I=1:1:L S C=C+$A(XTKRPK,I)

 S C=C\64#4+C#64 I $A(XTKRPK,L+1)-32-C S XTKERR="4 Bad checksum"

 Q

RTO S XTKERR="2 Receiver timeout" Q

SPACK S XTKSPK=$C($L(XTKSDAT)+35)_$C(XTKS("PN")+32)_XTKS("PT")_XTKSDAT,C=0 F I=1:1:$L(XTKSPK) S C=C+$A(XTKSPK,I)

 S C=C\64#4+C#64,XTKSPK=$C(XTKS("SOH"))_XTKSPK_$C(C+32)

 I $D(XTKDEBUG) S XTKDEBUG=XTKDEBUG+1,^TMP("XTKERM",$J,XTKDEBUG)="S:"_XTKSPK

 I XTKS("NPAD")>0 W $TR($J("",XTKS("NPAD"))," ",XTKS("PADC")) ;Send pad char.

 W XTKSPK,$C(XTKS("EOL"))

 Q

XTKERM3   ;SF/RWF - Kermit protocol Send/Receive packet ;8/19/92  11:19 ; [ 10/10/95  3:34 PM ]

 +1       ;;7.3;TOOLKIT;;Apr 25, 1995

 +2       ;Packet <Mark><Len><Seq><type><data><Check><Eol>

A         ;Setup <Maxl><Timeout><Npad><Padc><Eol><Qctrl><Qbin>

RPACK     ;Receive a packet

 +1        SET XTKERR=0

           SET XTKR("PT")="A"

           SET XTKR("PN")=99

           SET XTKRDAT=""

           SET XTKRPK=""

           FOR I=0:0

               READ A:XTKR("TO")

               IF '$TEST

                   GOTO RTO

               XECUTE XTKR("TRMRD")

               IF Y=XTKR("SOH")

                   QUIT 

 +2        READ XTKRPK:XTKR("TO")

           IF '$TEST

               GOTO RTO

           XECUTE XTKR("TRMRD")

           IF Y=XTKR("SOH")

               SET XTKERR="1 SOH in record"

               QUIT 

 +3        IF $DATA(XTKDEBUG)

               SET XTKDEBUG=XTKDEBUG+1

               SET ^TMP("XTKERM",$JOB,XTKDEBUG)="R:"_XTKRPK

RCK        SET L=$ASCII(XTKRPK)-32

           SET XTKR("PN")=$ASCII(XTKRPK,2)-32

           SET XTKR("PT")=$EXTRACT(XTKRPK,3)

           SET XTKRDAT=$EXTRACT(XTKRPK,4,L)

           IF $LENGTH(XTKRPK)-1-L

               SET XTKERR="3 Size error"

               QUIT 

 +1        SET C=0

           FOR I=1:1:L

               SET C=C+$ASCII(XTKRPK,I)

 +2        SET C=C\64#4+C#64

           IF $ASCII(XTKRPK,L+1)-32-C

               SET XTKERR="4 Bad checksum"

 +3        QUIT 

RTO        SET XTKERR="2 Receiver timeout"

           QUIT 

SPACK      SET XTKSPK=$CHAR($LENGTH(XTKSDAT)+35)_$CHAR(XTKS("PN")+32)_XTKS("PT")_XTKSDAT

           SET C=0

           FOR I=1:1:$LENGTH(XTKSPK)

               SET C=C+$ASCII(XTKSPK,I)

 +1        SET C=C\64#4+C#64

           SET XTKSPK=$CHAR(XTKS("SOH"))_XTKSPK_$CHAR(C+32)

 +2        IF $DATA(XTKDEBUG)

               SET XTKDEBUG=XTKDEBUG+1

               SET ^TMP("XTKERM",$JOB,XTKDEBUG)="S:"_XTKSPK

 +3       ;Send pad char.

           IF XTKS("NPAD")>0

               WRITE $TRANSLATE($JUSTIFY("",XTKS("NPAD"))," ",XTKS("PADC"))

 +4        WRITE XTKSPK,$CHAR(XTKS("EOL"))

 +5        QUIT