XTKERM3 ;SF/RWF - Kermit protocol Send/Receive packet ;8/19/92 11:19 ;
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTKERM3 1177 printed Dec 13, 2024@02:41:15 Page 2
XTKERM3 ;SF/RWF - Kermit protocol Send/Receive packet ;8/19/92 11:19 ;
+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
