Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMR

XMR.m

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