- 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 Jan 18, 2025@03:13:40 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