XMLTCP ;(WASH ISC)/CAP-TCP/IP to MailMan ;07/23/2002 06:54
;;8.0;MailMan;;Jun 28, 2002
; modified to run with MSM NT and Protocol TCP/IP-MAILMAN (file 3.4)
SEND ;returns ER(0 OR 1), XMLER=number of "soft" errors
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
E S X="C^XMCTRAP",@^%ZOSF("TRAP")
I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"S",XMSG,1)
W XMSG,$C(13,10),!
Q
REC ;Receive a line (must keep buffer / lines divided by LF)
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
E S X="C^XMCTRAP",@^%ZOSF("TRAP")
;Return line if read last time
RE G R:XMLTCP[$C(10) S %=255-$L(XMLTCP) G R:%<1
;Insure can clean up if line dropped, etc.
I $S(XMOS["VAX":1,+$G(XMOS("MSMVER"))<8:1,XMOS["OpenM-NT":1,1:0) R X#$S(%:%,1:1):$G(XMSTIME,160) G RE2
;Compliant with M standard
R X:$G(XMSTIME,60)
;
RE2 I '$T,"."_$C(10)'=XMLTCP S XMRG="" D ERTRAN^XMC1("Receiver timed out") Q
I X="" S ER=ER+.1 S:ER=1 XMRG="" Q:ER=1 H 1 G RE
S XMLTCP=XMLTCP_X I XMLTCP'[$C(10) G RE
R S %=$F(XMLTCP,$C(10))
;
;Strip out LF (and CR, if present)
I %,%<256 S XMRG=$E(XMLTCP,1,%-3+($A(XMLTCP,%-2)'=13)),XMLTCP=$E(XMLTCP,%,$L(XMLTCP)) G RQ
;
;Line too long or doesn't contain a Line Feed, return first 255 chars.
S XMRG=$E(XMLTCP,1,255),XMLTCP=$E(XMLTCP,256,$L(XMLTCP))
;S:$E(XMLTCP)="." XMLTCP="."_XMLTCP
;
RQ I $L(XMRG),$C(13,10)[$E(XMRG) S XMRG=$E(XMRG,2,$L(XMRG)) G RQ
I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"R",XMRG)
Q
SNDGTM ; Send for GT.M
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
E S X="C^XMCTRAP",@^%ZOSF("TRAP")
I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"S",XMSG,1)
W XMSG,$C(13,10),#
Q
RECGTM ; Receive for GT.M
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
E S X="C^XMCTRAP",@^%ZOSF("TRAP")
R XMRG:$G(XMSTIME,60)
I '$T S XMRG="" D ERTRAN^XMC1("Receiver timed out") Q
S XMRG=$TR(XMRG,$C(10,12,13))
I $G(XMINST) D XMTSTAT^XMTDR(XMINST,"R",XMRG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMLTCP 1943 printed Dec 13, 2024@02:12:38 Page 2
XMLTCP ;(WASH ISC)/CAP-TCP/IP to MailMan ;07/23/2002 06:54
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; modified to run with MSM NT and Protocol TCP/IP-MAILMAN (file 3.4)
SEND ;returns ER(0 OR 1), XMLER=number of "soft" errors
+1 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D C^XMCTRAP"
+2 IF '$TEST
SET X="C^XMCTRAP"
SET @^%ZOSF("TRAP")
+3 IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"S",XMSG,1)
+4 WRITE XMSG,$CHAR(13,10),!
+5 QUIT
REC ;Receive a line (must keep buffer / lines divided by LF)
+1 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D C^XMCTRAP"
+2 IF '$TEST
SET X="C^XMCTRAP"
SET @^%ZOSF("TRAP")
+3 ;Return line if read last time
RE if XMLTCP[$CHAR(10)
GOTO R
SET %=255-$LENGTH(XMLTCP)
if %<1
GOTO R
+1 ;Insure can clean up if line dropped, etc.
+2 IF $SELECT(XMOS["VAX":1,+$GET(XMOS("MSMVER"))<8:1,XMOS["OpenM-NT":1,1:0)
READ X#$SELECT(%:%,1:1):$GET(XMSTIME,160)
GOTO RE2
+3 ;Compliant with M standard
+4 READ X:$GET(XMSTIME,60)
+5 ;
RE2 IF '$TEST
IF "."_$CHAR(10)'=XMLTCP
SET XMRG=""
DO ERTRAN^XMC1("Receiver timed out")
QUIT
+1 IF X=""
SET ER=ER+.1
if ER=1
SET XMRG=""
if ER=1
QUIT
HANG 1
GOTO RE
+2 SET XMLTCP=XMLTCP_X
IF XMLTCP'[$CHAR(10)
GOTO RE
R SET %=$FIND(XMLTCP,$CHAR(10))
+1 ;
+2 ;Strip out LF (and CR, if present)
+3 IF %
IF %<256
SET XMRG=$EXTRACT(XMLTCP,1,%-3+($ASCII(XMLTCP,%-2)'=13))
SET XMLTCP=$EXTRACT(XMLTCP,%,$LENGTH(XMLTCP))
GOTO RQ
+4 ;
+5 ;Line too long or doesn't contain a Line Feed, return first 255 chars.
+6 SET XMRG=$EXTRACT(XMLTCP,1,255)
SET XMLTCP=$EXTRACT(XMLTCP,256,$LENGTH(XMLTCP))
+7 ;S:$E(XMLTCP)="." XMLTCP="."_XMLTCP
+8 ;
RQ IF $LENGTH(XMRG)
IF $CHAR(13,10)[$EXTRACT(XMRG)
SET XMRG=$EXTRACT(XMRG,2,$LENGTH(XMRG))
GOTO RQ
+1 IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"R",XMRG)
+2 QUIT
SNDGTM ; Send for GT.M
+1 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D C^XMCTRAP"
+2 IF '$TEST
SET X="C^XMCTRAP"
SET @^%ZOSF("TRAP")
+3 IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"S",XMSG,1)
+4 WRITE XMSG,$CHAR(13,10),#
+5 QUIT
RECGTM ; Receive for GT.M
+1 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D C^XMCTRAP"
+2 IF '$TEST
SET X="C^XMCTRAP"
SET @^%ZOSF("TRAP")
+3 READ XMRG:$GET(XMSTIME,60)
+4 IF '$TEST
SET XMRG=""
DO ERTRAN^XMC1("Receiver timed out")
QUIT
+5 SET XMRG=$TRANSLATE(XMRG,$CHAR(10,12,13))
+6 IF $GET(XMINST)
DO XMTSTAT^XMTDR(XMINST,"R",XMRG)
+7 QUIT
