- XMR ;ISC-SF/GMB-SMTP Receiver (RFC 821) ;09/24/2003 12:25
- ;;8.0;MailMan;**22,51**;Jun 28, 2002;Build 9
- ENT ; INITIALIZE
- S ER=0
- S XMC("NOREQUEUE")=1
- D GET^XMCXT(0)
- I '$D(XMC("BATCH")) S XMC("BATCH")=0
- D OPEN^XML I ER!$G(POP) D Q
- . D ^%ZISC:IO'=$G(IO(0)) W !,$C(7),$$EZBLD^DIALOG($S(ER:42227,1:37000)) ;Open failed / up-arrow out.
- S:'$D(XM) XM=""
- I XMC("BATCH") U IO
- E D
- . X ^%ZOSF("EOFF")
- . S X=255
- . X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD")
- S XMC("START")=$$TSTAMP^XMXUTIL1-.001
- D RECEIVE
- ;I $G(XMINST) D XMTFINIS^XMTDR(XMINST)
- Q
- RECEIVE ; BEGINNING OF INTERPRETER
- ; The following variables are used in here only. They are not
- ; 'new'd because this routine may be called recursively via the
- ; TURN command, which alternates sending and receiving.
- S XMC("DIR")="R"
- D KILL
- S XMEC=0,XMCONT="^HELP^NOOP^RSET^QUIT^STAT^CHRS^ECHO^"
- D DOTRAN^XMC1(42300,$$FMTE^XLFDT(DT,5)) ;Transcript Date: |1|
- S XMSTATE="^HELO^QUIT^"
- I 'XMC("BATCH") D
- . D BUFLUSH^XML
- . W:'$D(XMNO220) 220
- . H 2
- . S XMSG="220 "_$G(^XMB("NETNAME"))_" MailMan "_$P($T(XMR+1),";",3)_" ready" X XMSEN
- F D Q:ER!($G(XMCMD)="QUIT")!$G(XMC("QUIT"))
- . D DOTRAN^XMC1(42301) ;Waiting for input
- . S XMSTIME=300 X XMREC K XMSTIME Q:ER
- . S XMP=XMRG
- . F I=$C(9)," " F Q:XMP'[I S XMP=$P(XMP,I,1)_" "_$P(XMP,I,2,999) ; strip tabs / extra blanks
- . S XMCMD=$$UP^XLFSTR($P(XMP," ")),XMP=$P(XMP," ",2,999)
- . Q:XMCMD=""
- . I XMSTATE_XMCONT'[(U_XMCMD_U) D ERRCMD Q
- . I $T(@XMCMD)="" S XMSG="502 Command not implemented" X XMSEN Q
- . D @XMCMD
- I $G(XMCMD)="QUIT"!ER,$G(XMZ) D ZAPIT^XMXMSGS2(.5,.95,XMZ)
- S:$G(XMINST) $P(^XMBS(4.2999,XMINST,3),U,1,6)="^^^^^"
- D KILL
- Q
- KILL ;
- K I,X,XMC("HELO RECV"),XMCMD,XMCONT,XMEC,XMINSTR,XMNVFROM,XMP
- K XMREMID,XMRXMZ,XMRVAL,XMSTATE,XM2LONG,XMZ,XMZFDA,XMZIENS
- K XMERR,^TMP("XMERR",$J)
- Q
- CHRS ;;Christen this domain syntax: CHRS <parent>,<child>
- N XMPARENT,XMCHILD,X,Y,DIC
- S XMPARENT=$P(XMP,",",1),XMCHILD=$P(XMP,",",2)
- S X=XMPARENT
- S DIC=4.2,DIC(0)="MF"
- D ^DIC
- I +Y'=$P(^XMB(1,1,0),U,3) S XMSG="550 Parent name does not match locally initialized parent name" X XMSEN Q
- S X=XMCHILD
- S DIC=4.2
- D ^DIC
- I +Y'=$P(^XMB(1,1,0),U,1) S XMSG="550 Child name does not match locally initialized domain name" X XMSEN Q
- S ^XMB("NETNAME")=$P(Y,U,2)
- S $P(^XMB(1,1,0),U,4)=DT
- S XMSG="250 Local domain "_$P(Y,U,2)_" successfully christened by parent "_XMPARENT X XMSEN
- Q
- DATA ;;TEXT / ASSUMES VALID RECIPIENT
- D DATA^XMR3
- Q
- ECHO ;;ECHO TEST
- S XMSG="314 Echo mode. Received messages will be echoed until a single period is received" X XMSEN Q:ER
- F X XMREC Q:ER Q:XMRG="." S XMSG=XMRG X XMSEN Q:ER
- Q:ER
- S XMSG="250 End of echo mode" X XMSEN
- Q
- EXPN ;;EXPAND MAILING LIST
- ; disable EXPN command due to Tenable 10249 Multiple Mail Server EXPN/VRFY Information Disclosure
- Q
- N XMIEN,XMPTR,XMCNT,XMNETNAM,Y,X,DIC
- S X=XMP
- I X["<" S X=$P($P(X,"<",2),">")
- I "^G.^g.^"[(U_$E(X,1,2)_U) S X=$E(X,3,999)
- S DIC="^XMB(3.8,",DIC(0)="MF"
- D ^DIC I Y<0 S XMSG="550 mail group not found" X XMSEN Q
- S XMIEN=+Y,XMCNT=0,XMNETNAM=^XMB("NETNAME"),XMPTR=""
- F S XMPTR=$O(^XMB(3.8,XMIEN,1,"B",XMPTR)) Q:'XMPTR D Q:ER
- . Q:'$D(^VA(200,XMPTR,0))
- . S XMCNT=XMCNT+1
- . S XMSG="250 <"_$TR($$NAME^XMXUTIL(XMPTR),". ,","+_.")_"@"_XMNETNAM_">" X XMSEN
- I 'XMCNT S XMSG="250 No LOCAL members in group" X XMSEN Q:ER
- S XMSG="250 List SHOWS local members only, not member groups, remote members or distribution lists." X XMSEN
- Q
- HELO ;;HELO COMMAND
- D HELO^XMR1
- Q
- HELP ;;DISPLAY HELP MESSAGE
- D HELPME^XMR4
- Q
- MAIL ;;START
- D:$D(XMRVAL) VALSET^XMR1(XMINST,.XMRVAL)
- D MAIL^XMR1
- Q
- MESS ;;
- D MESS^XMR2
- Q
- NOOP ;;NO OPERATION FOR TESTING
- S XMSG="250 OK" X XMSEN
- Q
- QUIT ;;
- D:$D(XMRVAL) VALSET^XMR1(XMINST,.XMRVAL)
- S XMSG="221 "_$G(^XMB("NETNAME"))_" Service closing transmission channel" X XMSEN
- S XMC("QUIT")=1
- Q
- RCPT ;;
- D RCPT^XMR1
- Q
- RSET ;;RESET STATE TABLES
- N X,XMI,Y,DIC
- I $G(XMZ) D
- . I $D(^XMB(3.9,XMZ,0)),'$D(^XMB(3.9,XMZ,1,0)) D KILLMSG^XMXUTIL(XMZ)
- . I $D(^XMB(3.7,.5,2,.95,1,XMZ)) D ZAPIT^XMXMSGS2(.5,.95,XMZ)
- S XMSTATE="HELO^MAIL^"
- K XMZ,XMZFDA,XMZIENS,^TMP("XMY",$J),^TMP("XMY0",$J)
- S XMSG="250" X XMSEN Q
- Q
- STAT ;;
- N K,I,J
- I $G(XMNVFROM)'="" S XMSG="211-Current reverse path is: "_XMNVFROM X XMSEN Q:ER
- I $G(XMINST)'="" S XMSG="211-Current sender is: "_$P(^DIC(4.2,XMINST,0),U) X XMSEN Q:ER
- S XMSG="211-Acceptable commands at the moment are: " X XMSEN Q:ER
- S XMSG="211-"
- S K=XMSTATE_XMCONT F I=1:1:$L(K,U) S J=$P(K,U,I) I J'="" S XMSG=XMSG_J_" "
- X XMSEN Q:ER
- I $D(XMZ),$O(^XMB(3.9,XMZ,2,0))>0 D Q:ER
- . S J=0
- . S XMSG="211-Current text buffer is:" X XMSEN Q:ER
- . F S J=$O(^XMB(3.9,XMZ,2,J)) Q:J'>0 S XMSG="211-"_J_" "_^(J,0) X XMSEN Q:ER
- Q:ER
- I $O(^TMP("XMY",$J,""))'="" D Q:ER
- . S J=""
- . S XMSG="211-Current recipients are: " X XMSEN Q:ER
- . F S J=$O(^TMP("XMY",$J,J)) Q:J="" S XMSG="211-"_$S('J:J,1:$$NAME^XMXUTIL(J)) X XMSEN Q:ER
- Q:ER
- S XMSG="211 OK" X XMSEN
- Q
- TURN ;;
- D:$D(XMRVAL) VALSET^XMR1(XMINST,.XMRVAL)
- ;TURN AROUND PROTOCOL
- I $F("Yy",$P(^DIC(4.2,XMINST,0),U,16))>1 S XMSG="502 "_^XMB("NETNAME")_" has TURN disabled." X XMSEN Q
- I '$O(^XMB(3.7,.5,2,XMINST+1000,1,0)) S XMSG="502 "_^XMB("NETNAME")_" has no messages to export" X XMSEN Q
- I $P(^DIC(4.2,XMINST,0),U)'=$G(XMC("HELO RECV")) S XMSG="502 TURN command rejected." X XMSEN Q
- S XMSG="250 "_^XMB("NETNAME")_" has messages to export" X XMSEN Q:ER
- D KILL
- G SEND^XMS
- VRFY ;;VERIFY USER EXISTS
- ; disable VRFY command due to Tenable 10249 Multiple Mail Server EXPN/VRFY Information Disclosure
- Q
- N XMNAME
- S XMINSTR("ADDR FLAGS")="X" ; Do not expand
- S XMNAME=$$LOOKUP^XMR1(XMP,.XMINSTR)
- K XMINSTR("ADDR FLAGS")
- Q:XMNAME=0
- S XMSG="250 "_XMNAME_" <"_$TR(Y,". ,","+_.")_"@"_^XMB("NETNAME")_">" X XMSEN
- Q
- ERRCMD ;
- S XMEC=XMEC+1
- I XMEC>9 S ER=1,XMSG="500 too many errors or fatal error, closing channel"
- E S XMSG="500 Syntax error, command ("_XMCMD_") out of sequence, or unrecognized command"
- X XMSEN
- Q
- TST ;
- S XM="",XMC("BATCH")=0,XMC("DX")=1,XMCHAN="TEST"
- D OPEN^XML
- D RECEIVE
- D KILL^XMC
- Q
- DECNET ; Task-Task Communications
- I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D R^XMCTRAP"
- E S X="R^XMCTRAP",@^%ZOSF("TRAP")
- S (IO,I0(0))="SYS$NET",XMCHAN="DECNET" D DT^DICRW O IO U IO
- G ENT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMR 6401 printed Jan 18, 2025@03:13:52 Page 2
- XMR ;ISC-SF/GMB-SMTP Receiver (RFC 821) ;09/24/2003 12:25
- +1 ;;8.0;MailMan;**22,51**;Jun 28, 2002;Build 9
- ENT ; INITIALIZE
- +1 SET ER=0
- +2 SET XMC("NOREQUEUE")=1
- +3 DO GET^XMCXT(0)
- +4 IF '$DATA(XMC("BATCH"))
- SET XMC("BATCH")=0
- +5 DO OPEN^XML
- IF ER!$GET(POP)
- Begin DoDot:1
- +6 ;Open failed / up-arrow out.
- if IO'=$GET(IO(0))
- DO ^%ZISC
- WRITE !,$CHAR(7),$$EZBLD^DIALOG($SELECT(ER:42227,1:37000))
- End DoDot:1
- QUIT
- +7 if '$DATA(XM)
- SET XM=""
- +8 IF XMC("BATCH")
- USE IO
- +9 IF '$TEST
- Begin DoDot:1
- +10 XECUTE ^%ZOSF("EOFF")
- +11 SET X=255
- +12 XECUTE ^%ZOSF("RM")
- XECUTE ^%ZOSF("TYPE-AHEAD")
- End DoDot:1
- +13 SET XMC("START")=$$TSTAMP^XMXUTIL1-.001
- +14 DO RECEIVE
- +15 ;I $G(XMINST) D XMTFINIS^XMTDR(XMINST)
- +16 QUIT
- RECEIVE ; BEGINNING OF INTERPRETER
- +1 ; The following variables are used in here only. They are not
- +2 ; 'new'd because this routine may be called recursively via the
- +3 ; TURN command, which alternates sending and receiving.
- +4 SET XMC("DIR")="R"
- +5 DO KILL
- +6 SET XMEC=0
- SET XMCONT="^HELP^NOOP^RSET^QUIT^STAT^CHRS^ECHO^"
- +7 ;Transcript Date: |1|
- DO DOTRAN^XMC1(42300,$$FMTE^XLFDT(DT,5))
- +8 SET XMSTATE="^HELO^QUIT^"
- +9 IF 'XMC("BATCH")
- Begin DoDot:1
- +10 DO BUFLUSH^XML
- +11 if '$DATA(XMNO220)
- WRITE 220
- +12 HANG 2
- +13 SET XMSG="220 "_$GET(^XMB("NETNAME"))_" MailMan "_$PIECE($TEXT(XMR+1),";",3)_" ready"
- XECUTE XMSEN
- End DoDot:1
- +14 FOR
- Begin DoDot:1
- +15 ;Waiting for input
- DO DOTRAN^XMC1(42301)
- +16 SET XMSTIME=300
- XECUTE XMREC
- KILL XMSTIME
- if ER
- QUIT
- +17 SET XMP=XMRG
- +18 ; strip tabs / extra blanks
- FOR I=$CHAR(9)," "
- FOR
- if XMP'[I
- QUIT
- SET XMP=$PIECE(XMP,I,1)_" "_$PIECE(XMP,I,2,999)
- +19 SET XMCMD=$$UP^XLFSTR($PIECE(XMP," "))
- SET XMP=$PIECE(XMP," ",2,999)
- +20 if XMCMD=""
- QUIT
- +21 IF XMSTATE_XMCONT'[(U_XMCMD_U)
- DO ERRCMD
- QUIT
- +22 IF $TEXT(@XMCMD)=""
- SET XMSG="502 Command not implemented"
- XECUTE XMSEN
- QUIT
- +23 DO @XMCMD
- End DoDot:1
- if ER!($GET(XMCMD)="QUIT")!$GET(XMC("QUIT"))
- QUIT
- +24 IF $GET(XMCMD)="QUIT"!ER
- IF $GET(XMZ)
- DO ZAPIT^XMXMSGS2(.5,.95,XMZ)
- +25 if $GET(XMINST)
- SET $PIECE(^XMBS(4.2999,XMINST,3),U,1,6)="^^^^^"
- +26 DO KILL
- +27 QUIT
- KILL ;
- +1 KILL I,X,XMC("HELO RECV"),XMCMD,XMCONT,XMEC,XMINSTR,XMNVFROM,XMP
- +2 KILL XMREMID,XMRXMZ,XMRVAL,XMSTATE,XM2LONG,XMZ,XMZFDA,XMZIENS
- +3 KILL XMERR,^TMP("XMERR",$JOB)
- +4 QUIT
- CHRS ;;Christen this domain syntax: CHRS <parent>,<child>
- +1 NEW XMPARENT,XMCHILD,X,Y,DIC
- +2 SET XMPARENT=$PIECE(XMP,",",1)
- SET XMCHILD=$PIECE(XMP,",",2)
- +3 SET X=XMPARENT
- +4 SET DIC=4.2
- SET DIC(0)="MF"
- +5 DO ^DIC
- +6 IF +Y'=$PIECE(^XMB(1,1,0),U,3)
- SET XMSG="550 Parent name does not match locally initialized parent name"
- XECUTE XMSEN
- QUIT
- +7 SET X=XMCHILD
- +8 SET DIC=4.2
- +9 DO ^DIC
- +10 IF +Y'=$PIECE(^XMB(1,1,0),U,1)
- SET XMSG="550 Child name does not match locally initialized domain name"
- XECUTE XMSEN
- QUIT
- +11 SET ^XMB("NETNAME")=$PIECE(Y,U,2)
- +12 SET $PIECE(^XMB(1,1,0),U,4)=DT
- +13 SET XMSG="250 Local domain "_$PIECE(Y,U,2)_" successfully christened by parent "_XMPARENT
- XECUTE XMSEN
- +14 QUIT
- DATA ;;TEXT / ASSUMES VALID RECIPIENT
- +1 DO DATA^XMR3
- +2 QUIT
- ECHO ;;ECHO TEST
- +1 SET XMSG="314 Echo mode. Received messages will be echoed until a single period is received"
- XECUTE XMSEN
- if ER
- QUIT
- +2 FOR
- XECUTE XMREC
- if ER
- QUIT
- if XMRG="."
- QUIT
- SET XMSG=XMRG
- XECUTE XMSEN
- if ER
- QUIT
- +3 if ER
- QUIT
- +4 SET XMSG="250 End of echo mode"
- XECUTE XMSEN
- +5 QUIT
- EXPN ;;EXPAND MAILING LIST
- +1 ; disable EXPN command due to Tenable 10249 Multiple Mail Server EXPN/VRFY Information Disclosure
- +2 QUIT
- +3 NEW XMIEN,XMPTR,XMCNT,XMNETNAM,Y,X,DIC
- +4 SET X=XMP
- +5 IF X["<"
- SET X=$PIECE($PIECE(X,"<",2),">")
- +6 IF "^G.^g.^"[(U_$EXTRACT(X,1,2)_U)
- SET X=$EXTRACT(X,3,999)
- +7 SET DIC="^XMB(3.8,"
- SET DIC(0)="MF"
- +8 DO ^DIC
- IF Y<0
- SET XMSG="550 mail group not found"
- XECUTE XMSEN
- QUIT
- +9 SET XMIEN=+Y
- SET XMCNT=0
- SET XMNETNAM=^XMB("NETNAME")
- SET XMPTR=""
- +10 FOR
- SET XMPTR=$ORDER(^XMB(3.8,XMIEN,1,"B",XMPTR))
- if 'XMPTR
- QUIT
- Begin DoDot:1
- +11 if '$DATA(^VA(200,XMPTR,0))
- QUIT
- +12 SET XMCNT=XMCNT+1
- +13 SET XMSG="250 <"_$TRANSLATE($$NAME^XMXUTIL(XMPTR),". ,","+_.")_"@"_XMNETNAM_">"
- XECUTE XMSEN
- End DoDot:1
- if ER
- QUIT
- +14 IF 'XMCNT
- SET XMSG="250 No LOCAL members in group"
- XECUTE XMSEN
- if ER
- QUIT
- +15 SET XMSG="250 List SHOWS local members only, not member groups, remote members or distribution lists."
- XECUTE XMSEN
- +16 QUIT
- HELO ;;HELO COMMAND
- +1 DO HELO^XMR1
- +2 QUIT
- HELP ;;DISPLAY HELP MESSAGE
- +1 DO HELPME^XMR4
- +2 QUIT
- MAIL ;;START
- +1 if $DATA(XMRVAL)
- DO VALSET^XMR1(XMINST,.XMRVAL)
- +2 DO MAIL^XMR1
- +3 QUIT
- MESS ;;
- +1 DO MESS^XMR2
- +2 QUIT
- NOOP ;;NO OPERATION FOR TESTING
- +1 SET XMSG="250 OK"
- XECUTE XMSEN
- +2 QUIT
- QUIT ;;
- +1 if $DATA(XMRVAL)
- DO VALSET^XMR1(XMINST,.XMRVAL)
- +2 SET XMSG="221 "_$GET(^XMB("NETNAME"))_" Service closing transmission channel"
- XECUTE XMSEN
- +3 SET XMC("QUIT")=1
- +4 QUIT
- RCPT ;;
- +1 DO RCPT^XMR1
- +2 QUIT
- RSET ;;RESET STATE TABLES
- +1 NEW X,XMI,Y,DIC
- +2 IF $GET(XMZ)
- Begin DoDot:1
- +3 IF $DATA(^XMB(3.9,XMZ,0))
- IF '$DATA(^XMB(3.9,XMZ,1,0))
- DO KILLMSG^XMXUTIL(XMZ)
- +4 IF $DATA(^XMB(3.7,.5,2,.95,1,XMZ))
- DO ZAPIT^XMXMSGS2(.5,.95,XMZ)
- End DoDot:1
- +5 SET XMSTATE="HELO^MAIL^"
- +6 KILL XMZ,XMZFDA,XMZIENS,^TMP("XMY",$JOB),^TMP("XMY0",$JOB)
- +7 SET XMSG="250"
- XECUTE XMSEN
- QUIT
- +8 QUIT
- STAT ;;
- +1 NEW K,I,J
- +2 IF $GET(XMNVFROM)'=""
- SET XMSG="211-Current reverse path is: "_XMNVFROM
- XECUTE XMSEN
- if ER
- QUIT
- +3 IF $GET(XMINST)'=""
- SET XMSG="211-Current sender is: "_$PIECE(^DIC(4.2,XMINST,0),U)
- XECUTE XMSEN
- if ER
- QUIT
- +4 SET XMSG="211-Acceptable commands at the moment are: "
- XECUTE XMSEN
- if ER
- QUIT
- +5 SET XMSG="211-"
- +6 SET K=XMSTATE_XMCONT
- FOR I=1:1:$LENGTH(K,U)
- SET J=$PIECE(K,U,I)
- IF J'=""
- SET XMSG=XMSG_J_" "
- +7 XECUTE XMSEN
- if ER
- QUIT
- +8 IF $DATA(XMZ)
- IF $ORDER(^XMB(3.9,XMZ,2,0))>0
- Begin DoDot:1
- +9 SET J=0
- +10 SET XMSG="211-Current text buffer is:"
- XECUTE XMSEN
- if ER
- QUIT
- +11 FOR
- SET J=$ORDER(^XMB(3.9,XMZ,2,J))
- if J'>0
- QUIT
- SET XMSG="211-"_J_" "_^(J,0)
- XECUTE XMSEN
- if ER
- QUIT
- End DoDot:1
- if ER
- QUIT
- +12 if ER
- QUIT
- +13 IF $ORDER(^TMP("XMY",$JOB,""))'=""
- Begin DoDot:1
- +14 SET J=""
- +15 SET XMSG="211-Current recipients are: "
- XECUTE XMSEN
- if ER
- QUIT
- +16 FOR
- SET J=$ORDER(^TMP("XMY",$JOB,J))
- if J=""
- QUIT
- SET XMSG="211-"_$SELECT('J:J,1:$$NAME^XMXUTIL(J))
- XECUTE XMSEN
- if ER
- QUIT
- End DoDot:1
- if ER
- QUIT
- +17 if ER
- QUIT
- +18 SET XMSG="211 OK"
- XECUTE XMSEN
- +19 QUIT
- TURN ;;
- +1 if $DATA(XMRVAL)
- DO VALSET^XMR1(XMINST,.XMRVAL)
- +2 ;TURN AROUND PROTOCOL
- +3 IF $FIND("Yy",$PIECE(^DIC(4.2,XMINST,0),U,16))>1
- SET XMSG="502 "_^XMB("NETNAME")_" has TURN disabled."
- XECUTE XMSEN
- QUIT
- +4 IF '$ORDER(^XMB(3.7,.5,2,XMINST+1000,1,0))
- SET XMSG="502 "_^XMB("NETNAME")_" has no messages to export"
- XECUTE XMSEN
- QUIT
- +5 IF $PIECE(^DIC(4.2,XMINST,0),U)'=$GET(XMC("HELO RECV"))
- SET XMSG="502 TURN command rejected."
- XECUTE XMSEN
- QUIT
- +6 SET XMSG="250 "_^XMB("NETNAME")_" has messages to export"
- XECUTE XMSEN
- if ER
- QUIT
- +7 DO KILL
- +8 GOTO SEND^XMS
- VRFY ;;VERIFY USER EXISTS
- +1 ; disable VRFY command due to Tenable 10249 Multiple Mail Server EXPN/VRFY Information Disclosure
- +2 QUIT
- +3 NEW XMNAME
- +4 ; Do not expand
- SET XMINSTR("ADDR FLAGS")="X"
- +5 SET XMNAME=$$LOOKUP^XMR1(XMP,.XMINSTR)
- +6 KILL XMINSTR("ADDR FLAGS")
- +7 if XMNAME=0
- QUIT
- +8 SET XMSG="250 "_XMNAME_" <"_$TRANSLATE(Y,". ,","+_.")_"@"_^XMB("NETNAME")_">"
- XECUTE XMSEN
- +9 QUIT
- ERRCMD ;
- +1 SET XMEC=XMEC+1
- +2 IF XMEC>9
- SET ER=1
- SET XMSG="500 too many errors or fatal error, closing channel"
- +3 IF '$TEST
- SET XMSG="500 Syntax error, command ("_XMCMD_") out of sequence, or unrecognized command"
- +4 XECUTE XMSEN
- +5 QUIT
- TST ;
- +1 SET XM=""
- SET XMC("BATCH")=0
- SET XMC("DX")=1
- SET XMCHAN="TEST"
- +2 DO OPEN^XML
- +3 DO RECEIVE
- +4 DO KILL^XMC
- +5 QUIT
- DECNET ; Task-Task Communications
- +1 IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP="D R^XMCTRAP"
- +2 IF '$TEST
- SET X="R^XMCTRAP"
- SET @^%ZOSF("TRAP")
- +3 SET (IO,I0(0))="SYS$NET"
- SET XMCHAN="DECNET"
- DO DT^DICRW
- OPEN IO
- USE IO
- +4 GOTO ENT