XMR1 ;ISC-SF/GMB-SMTP Receiver HELO/MAIL/RCPT (RFC 821) ;02/10/2004 06:31
;;8.0;MailMan;**6,24**;Jun 28, 2002
HELO ; Recv: "HELO REMOTE.MED.VA.GOV <security num>"
; Send: "250 OK DOMAIN.NAME <security num> [8.0,DUP,SER,FTP]"
N X,Y,XMDOMREC
I XMP="" S XMSG="501 Missing domain specification" X XMSEN Q
I '$D(^XMB("NETNAME")) S XMSG="550 Unchristened local domain" X XMSEN Q
S X=$P(XMP,"<")
I $E(X,$L(X))="." S XMSG="501 Invalid Domain Name" X XMSEN Q
S XMSTATE="^HELO^QUIT^"
S X=$$UP^XLFSTR(X)
S Y=$$FACILITY(X)
I Y>0 D
. S XMINST=+Y
. S (XMSITE,XMC("HELO RECV"))=$P(Y,U,2)
E I $$REJECT(X) D Q
. S XMSG="421 Service not available, closing transmission channel" X XMSEN
. S XMC("QUIT")=1
E D
. S XMC("HELO RECV")=X
. S Y=$$DOMAIN(X)
. S XMINST=+Y
. S XMSITE=$P(Y,U,2)
I +$G(^XMB(1,1,4)) D
. D NORELAY
E S XMC("RELAY OK")=1
I XMC("BATCH") S XMSTATE="^MAIL^",XMCONT=XMCONT_"TURN^MESS^" Q
S XMDOMREC=^DIC(4.2,XMINST,0)
I $P(XMDOMREC,U,15) D VALPROC(XMINST,XMDOMREC,XMP,.XMRVAL) Q:'$D(XMRVAL)
S XMSG="250 OK "_^XMB("NETNAME")_$S($D(XMRVAL):" <"_XMRVAL_">",1:"")_" ["_$P($T(XMR1+1),";",3)_",DUP,SER,FTP]" X XMSEN
S XMSTATE="^MAIL^",XMCONT=XMCONT_"TURN^MESS^"
Q
NORELAY ; We want to prevent this site from unwittingly acting as a relay
; domain for spammers or viruses. Such nefarious ne'erdowells
; typically route their mail through unsuspecting sites to "launder"
; it. The unsuspecting sites forward it onward.
; XMC("HELO RECV") contains the sending site's name. If we
; were to be truly vigorous about this, we would find out the IP
; address of the site and do a reverse DNS lookup to verify the site's
; name. We don't yet have that capability, so we'll have to make do
; with XMC("HELO RECV") and trust that the site is who it says it is.
N XMOKDOM
S XMOKDOM="" ; Get list of acceptable sites
F S XMOKDOM=$O(^XMB(1,1,4.1,"B",XMOKDOM)) Q:XMOKDOM="" D
. S XMC("MY DOMAIN",$$UP^XLFSTR(XMOKDOM))=""
I $F(^XMB("NETNAME"),".VA.GOV")=($L(^XMB("NETNAME"))+1) D
. ; This is a VA site. Make sure mail from other VA sites is relayed.
. I '$D(XMC("MY DOMAIN",".VA.GOV")) S XMC("MY DOMAIN",^XMB("NETNAME"))=""
S XMOKDOM="" ; Make sure this site is an acceptable site!
F S XMOKDOM=$O(XMC("MY DOMAIN",XMOKDOM)) Q:XMOKDOM="" Q:$F(^XMB("NETNAME"),XMOKDOM)=($L(^XMB("NETNAME"))+1)
I XMOKDOM="" S XMC("MY DOMAIN",^XMB("NETNAME"))="" ; Default
; Set XMC("RELAY OK")=1 if the sending site is acceptable.
S XMOKDOM=""
F S XMOKDOM=$O(XMC("MY DOMAIN",XMOKDOM)) Q:XMOKDOM="" Q:$F(XMC("HELO RECV"),XMOKDOM)=($L(XMC("HELO RECV"))+1)
S XMC("RELAY OK")=XMOKDOM'=""
Q
FACILITY(X) ; If full domain name is found in domain file, either as main
; entry or as synonym, return main entry. "Domain IEN^Domain name"
N DIC,Y,D
S DIC="^DIC(4.2,",DIC(0)="FMOZ",D="B^C"
D MIX^DIC1
Q $S(Y>0:+Y_U_Y(0,0),1:Y)
DOMAIN(XMDOMAIN) ; Try to find the domain.
N DIC,X,Y,D
S (X,XMDOMAIN)=$$UP^XLFSTR(XMDOMAIN)
S DIC="^DIC(4.2,",DIC(0)="FMXZ",D="B^C"
F D MIX^DIC1 Q:Y>0!(X'[".") S X=$P(X,".",2,99)
Q:Y>0 +Y_U_Y(0,0)
N XMTOP
S XMTOP=X
; If the top-level domain is found in the Internet Suffix file, then
; just pretend that we're talking to this site's parent.
; (TURN command will be disabled.)
I $$FIND1^DIC(4.2996,"","QX",XMTOP) Q ^XMB("PARENT")_U_$P(^DIC(4.2,^XMB("PARENT"),0),U,1)
; Add the top-level domain to the DOMAIN file.
N XMFDA,XMIENS,XMIEN
S XMIENS="?+1,"
S XMFDA(4.2,XMIENS,.01)=XMTOP ; Top-level domain name
S XMFDA(4.2,XMIENS,1)="C" ; Closed
S XMFDA(4.2,XMIENS,1.7)="y" ; Disable TURN command
S XMFDA(4.2,XMIENS,2)=^XMB("PARENT") ; Relay domain
D UPDATE^DIE("","XMFDA","XMIEN")
; If there's a problem with adding the top-level domain to the DOMAIN
; file, just pretend that we're talking to this site's parent.
; (TURN command will be disabled.)
I $D(DIERR) Q ^XMB("PARENT")_U_$P(^DIC(4.2,^XMB("PARENT"),0),U,1)
; Notify someone that we've added a new domain to the DOMAIN file.
N XMINSTR,XMPARM
S XMPARM(1)=XMTOP
S XMPARM(2)=XMDOMAIN
S XMINSTR("FROM")="POSTMASTER"
D TASKBULL^XMXBULL(.5,"XM DOMAIN ADDED",.XMPARM,,,.XMINSTR)
Q XMIEN(1)_U_XMTOP
VALPROC(XMINST,XMDOMREC,XMP,XMRVAL) ; Check validation number
L +^DIC(4.2,XMINST,0):0 E S XMSG="550 Domain file locked, try later" X XMSEN Q
S XMRVAL=$P($P(XMP,"<",2),">")
D VALCHK(.XMDOMREC,XMRVAL)
I '$D(XMRVAL) L -^DIC(4.2,XMINST,0) Q
S XMRVAL=$R(8000000)+1000000 ; generate new validation number
;set val. num in return message, set new Val. num field
S $P(XMDOMREC,U,18)=XMRVAL
S ^DIC(4.2,XMINST,0)=XMDOMREC
Q
VALCHK(XMDOMREC,XMRVAL) ; Check the validation number
Q:XMRVAL=$P(XMDOMREC,U,15) ; 15=current number; 18=new number
I XMRVAL=$P(XMDOMREC,U,18) S $P(XMDOMREC,U,15)=$P(XMDOMREC,U,18) Q
K XMRVAL
N XMPARM,XMINSTR
S XMINSTR("FROM")="POSTMASTER"
S XMPARM(1)=XMC("HELO RECV")
D TASKBULL^XMXBULL(.5,"XMVALBAD",.XMPARM,"","",.XMINSTR)
S XMSG="550 Bad validation number" X XMSEN
Q
VALSET(XMINST,XMRVAL) ;check validation number
;if new val. num. exist, then set val. num. to it and set to null
Q:'$G(XMRVAL)
N XMDOMREC
S XMDOMREC=$G(^DIC(4.2,XMINST,0))
S $P(XMDOMREC,U,15)=XMRVAL
S $P(XMDOMREC,U,18)=""
S ^DIC(4.2,XMINST,0)=XMDOMREC
L -^DIC(4.2,XMINST,0)
K XMRVAL
Q
MAIL ; Recv: "MAIL FROM:<USER.JOE@DOMAIN.NAME>"
; Send: "250 OK Message-ID:12345@DOMAIN.NAME"
N XMD
S XMP=$P(XMP,":",2,999)
S XMP=$$SCRUB^XMR3(XMP)
I XMP'?1"<>",(XMP'?1"<"1.E1"@"1.E1">") S XMSG="501 Invalid reverse-path specification" X XMSEN Q
I $$REJECT(XMP) S XMSG="502 No message receipt authorization." X XMSEN Q
K XMINSTR,XMNVFROM,XMREMID,XMRXMZ,XM2LONG,XMZ,XMZFDA,XMZIENS,^TMP("XMY",$J),^TMP("XMY0",$J)
S XMINSTR("FWD BY")="" ; We're not sure who sent/forwarded it
S XMINSTR("ADDR FLAGS")="R"
K:$D(XMERR) XMERR K:$D(^TMP("XMERR",$J)) ^TMP("XMERR",$J)
D CRE8XMZ^XMXSEND($$EZBLD^DIALOG(34012),.XMZ) ; * No Subject *
I $D(XMERR) D Q
. S XMSG="555 "_^TMP("XMERR",$J,1,"TEXT",1)
. K XMERR,^TMP("XMERR",$J)
. X XMSEN
S XMZIENS=XMZ_","
S (XMNVFROM,XMZFDA(3.9,XMZIENS,1),XMZFDA(3.9,XMZIENS,41))=XMP ; mail from
S XMSTATE="^RCPT^DATA"
S (XMD,XMZFDA(3.9,XMZIENS,1.4))=$$NOW^XLFDT() ; Message date default
S $P(^XMB(3.9,XMZ,0),U,3)=XMD
D PUTMSG^XMXMSGS2(.5,.95,"ARRIVING",XMZ)
S XMSG="250 OK Message-ID:"_XMZ_"@"_^XMB("NETNAME") X XMSEN Q:ER
S XMD=$$INDT^XMXUTIL1(XMD)
;DON'T CHANGE ORDER OF .001 & .002 LINES !
S ^XMB(3.9,XMZ,2,.001,0)="Received: "_$S($L($G(XMC("HELO RECV"))):"from "_XMC("HELO RECV")_" by "_^XMB("NETNAME")_" (MailMan/"_$P($T(XMR1+1),";",3)_" "_XMPROT_")",1:"(BATCH)")_" id "_XMZ_" ; "_XMD
N XMFDA,XMIENS
S XMIENS=XMINST_","
S XMFDA(4.2999,XMIENS,1)=$H
S XMFDA(4.2999,XMIENS,2)=XMZ ; Message in transit
;S XMFDA(4.2999,XMIENS,3)="@" ; Last line xmit'd
D FILE^DIE("","XMFDA")
Q
REJECT(XMNVFROM) ; Check Senders rejected list
Q:'$O(^XMBX(4.501,0)) 0
N XMNO,XMREJECT,XMIEN,XMREC
S XMNVFROM=$$UP^XLFSTR(XMNVFROM)
S XMNO="",XMREJECT=0
F S XMNO=$O(^XMBX(4.501,"B",XMNO)) Q:XMNO="" D Q:XMREJECT
. Q:XMNVFROM'[$$UP^XLFSTR(XMNO)
. S XMIEN=$O(^XMBX(4.501,"B",XMNO,0)) Q:'XMIEN
. S XMREC=$G(^XMBX(4.501,XMIEN,0)) Q:XMREC=""
. I XMNVFROM[$$UP^XLFSTR($P(XMREC,U,1)),'$P(XMREC,U,2) S XMREJECT=1
Q XMREJECT
RCPT ; Specify recipients
S XMP=$P(XMP,":",2,999) I XMP="" S XMSG="501 Invalid forward path specification" X XMSEN Q
I XMP["> FWD BY:" S XMINSTR("NET FWD BY")=$P(XMP,"> FWD BY:",2)
E K XMINSTR("NET FWD BY")
Q:$$LOOKUP(XMP,.XMINSTR)=0
S XMSG="250 'RCPT' accepted" X XMSEN
S XMSTATE="^DATA^RCPT"
Q
LOOKUP(XMTO,XMINSTR) ;
N XMFULL,XMRESTR
S XMRESTR("NET RECEIVE")=$G(XMNVFROM)
S XMTO=$TR($P($P(XMTO,">",1),"<",2,99),"<") ; I've seen <<user@site> and <<user@site>>
I XMTO="" S XMSG="550 Malformed address" X XMSEN Q 0
I $E(XMTO,1)'="""",XMTO?1"@"1.E1":"1.E1"@"1.E S XMTO=$P(XMTO,":",2)
D CHKADDR^XMXADDR(.5,XMTO,.XMINSTR,.XMRESTR,.XMFULL)
I $D(XMERR) D Q 0
. S XMSG="550 "_^TMP("XMERR",$J,XMERR,"TEXT",1)
. X XMSEN
. K XMERR,^TMP("XMERR",$J)
I $G(XMFULL)="SHARED,MAIL" D Q 0
. S XMSG="550 'Shared,Mail' user may not receive network mail."
. X XMSEN
. K ^TMP("XMY",$J,.6),^TMP("XMY0",$J,"SHARED,MAIL")
; Don't act as a relay domain for unauthorized sites.
I XMFULL'["@" Q XMFULL ; Local address OK
I XMC("RELAY OK") Q XMFULL ; Relay from accepted site
N XMOKDOM,XMTRELAY
S XMTRELAY=$P(XMFULL,"@",2)
S XMOKDOM=""
F S XMOKDOM=$O(XMC("MY DOMAIN",XMOKDOM)) Q:XMOKDOM="" Q:$F(XMTRELAY,XMOKDOM)=($L(XMTRELAY)+1)
I XMOKDOM'="" Q XMFULL ; Relay from an outside site to an inside site.
; Relay from an outside site to an outside site.
S XMSG="550 Relaying denied."
X XMSEN
K ^TMP("XMY",$J,XMFULL),^TMP("XMY0",$J,XMFULL)
; Notify someone that a relay attempt was denied.
N XMINSTR,XMPARM,XMTO
S XMPARM(1)=XMC("HELO RECV")
S XMPARM(2)=XMFULL
S XMPARM(3)=XMNVFROM
S XMINSTR("FROM")="POSTMASTER"
S XMTO(.5)=""
D TASKBULL^XMXBULL(.5,"XM RELAY ATTEMPTED",.XMPARM,,.XMTO,.XMINSTR)
Q 0
XMR1 ;ISC-SF/GMB-SMTP Receiver HELO/MAIL/RCPT (RFC 821) ;02/10/2004 06:31
+1 ;;8.0;MailMan;**6,24**;Jun 28, 2002
HELO ; Recv: "HELO REMOTE.MED.VA.GOV <security num>"
+1 ; Send: "250 OK DOMAIN.NAME <security num> [8.0,DUP,SER,FTP]"
+2 NEW X,Y,XMDOMREC
+3 IF XMP=""
SET XMSG="501 Missing domain specification"
XECUTE XMSEN
QUIT
+4 IF '$DATA(^XMB("NETNAME"))
SET XMSG="550 Unchristened local domain"
XECUTE XMSEN
QUIT
+5 SET X=$PIECE(XMP,"<")
+6 IF $EXTRACT(X,$LENGTH(X))="."
SET XMSG="501 Invalid Domain Name"
XECUTE XMSEN
QUIT
+7 SET XMSTATE="^HELO^QUIT^"
+8 SET X=$$UP^XLFSTR(X)
+9 SET Y=$$FACILITY(X)
+10 IF Y>0
Begin DoDot:1
+11 SET XMINST=+Y
+12 SET (XMSITE,XMC("HELO RECV"))=$PIECE(Y,U,2)
End DoDot:1
+13 IF '$TEST
IF $$REJECT(X)
Begin DoDot:1
+14 SET XMSG="421 Service not available, closing transmission channel"
XECUTE XMSEN
+15 SET XMC("QUIT")=1
End DoDot:1
QUIT
+16 IF '$TEST
Begin DoDot:1
+17 SET XMC("HELO RECV")=X
+18 SET Y=$$DOMAIN(X)
+19 SET XMINST=+Y
+20 SET XMSITE=$PIECE(Y,U,2)
End DoDot:1
+21 IF +$GET(^XMB(1,1,4))
Begin DoDot:1
+22 DO NORELAY
End DoDot:1
+23 IF '$TEST
SET XMC("RELAY OK")=1
+24 IF XMC("BATCH")
SET XMSTATE="^MAIL^"
SET XMCONT=XMCONT_"TURN^MESS^"
QUIT
+25 SET XMDOMREC=^DIC(4.2,XMINST,0)
+26 IF $PIECE(XMDOMREC,U,15)
DO VALPROC(XMINST,XMDOMREC,XMP,.XMRVAL)
IF '$DATA(XMRVAL)
QUIT
+27 SET XMSG="250 OK "_^XMB("NETNAME")_$SELECT($DATA(XMRVAL):" <"_XMRVAL_">",1:"")_" ["_$PIECE($TEXT(XMR1+1),";",3)_",DUP,SER,FTP]"
XECUTE XMSEN
+28 SET XMSTATE="^MAIL^"
SET XMCONT=XMCONT_"TURN^MESS^"
+29 QUIT
NORELAY ; We want to prevent this site from unwittingly acting as a relay
+1 ; domain for spammers or viruses. Such nefarious ne'erdowells
+2 ; typically route their mail through unsuspecting sites to "launder"
+3 ; it. The unsuspecting sites forward it onward.
+4 ; XMC("HELO RECV") contains the sending site's name. If we
+5 ; were to be truly vigorous about this, we would find out the IP
+6 ; address of the site and do a reverse DNS lookup to verify the site's
+7 ; name. We don't yet have that capability, so we'll have to make do
+8 ; with XMC("HELO RECV") and trust that the site is who it says it is.
+9 NEW XMOKDOM
+10 ; Get list of acceptable sites
SET XMOKDOM=""
+11 FOR
SET XMOKDOM=$ORDER(^XMB(1,1,4.1,"B",XMOKDOM))
IF XMOKDOM=""
QUIT
Begin DoDot:1
+12 SET XMC("MY DOMAIN",$$UP^XLFSTR(XMOKDOM))=""
End DoDot:1
+13 IF $FIND(^XMB("NETNAME"),".VA.GOV")=($LENGTH(^XMB("NETNAME"))+1)
Begin DoDot:1
+14 ; This is a VA site. Make sure mail from other VA sites is relayed.
+15 IF '$DATA(XMC("MY DOMAIN",".VA.GOV"))
SET XMC("MY DOMAIN",^XMB("NETNAME"))=""
End DoDot:1
+16 ; Make sure this site is an acceptable site!
SET XMOKDOM=""
+17 FOR
SET XMOKDOM=$ORDER(XMC("MY DOMAIN",XMOKDOM))
IF XMOKDOM=""
QUIT
IF $FIND(^XMB("NETNAME"),XMOKDOM)=($LENGTH(^XMB("NETNAME"))+1)
QUIT
+18 ; Default
IF XMOKDOM=""
SET XMC("MY DOMAIN",^XMB("NETNAME"))=""
+19 ; Set XMC("RELAY OK")=1 if the sending site is acceptable.
+20 SET XMOKDOM=""
+21 FOR
SET XMOKDOM=$ORDER(XMC("MY DOMAIN",XMOKDOM))
IF XMOKDOM=""
QUIT
IF $FIND(XMC("HELO RECV"),XMOKDOM)=($LENGTH(XMC("HELO RECV"))+1)
QUIT
+22 SET XMC("RELAY OK")=XMOKDOM'=""
+23 QUIT
FACILITY(X) ; If full domain name is found in domain file, either as main
+1 ; entry or as synonym, return main entry. "Domain IEN^Domain name"
+2 NEW DIC,Y,D
+3 SET DIC="^DIC(4.2,"
SET DIC(0)="FMOZ"
SET D="B^C"
+4 DO MIX^DIC1
+5 QUIT $SELECT(Y>0:+Y_U_Y(0,0),1:Y)
DOMAIN(XMDOMAIN) ; Try to find the domain.
+1 NEW DIC,X,Y,D
+2 SET (X,XMDOMAIN)=$$UP^XLFSTR(XMDOMAIN)
+3 SET DIC="^DIC(4.2,"
SET DIC(0)="FMXZ"
SET D="B^C"
+4 FOR
DO MIX^DIC1
IF Y>0!(X'[".")
QUIT
SET X=$PIECE(X,".",2,99)
+5 IF Y>0
QUIT +Y_U_Y(0,0)
+6 NEW XMTOP
+7 SET XMTOP=X
+8 ; If the top-level domain is found in the Internet Suffix file, then
+9 ; just pretend that we're talking to this site's parent.
+10 ; (TURN command will be disabled.)
+11 IF $$FIND1^DIC(4.2996,"","QX",XMTOP)
QUIT ^XMB("PARENT")_U_$PIECE(^DIC(4.2,^XMB("PARENT"),0),U,1)
+12 ; Add the top-level domain to the DOMAIN file.
+13 NEW XMFDA,XMIENS,XMIEN
+14 SET XMIENS="?+1,"
+15 ; Top-level domain name
SET XMFDA(4.2,XMIENS,.01)=XMTOP
+16 ; Closed
SET XMFDA(4.2,XMIENS,1)="C"
+17 ; Disable TURN command
SET XMFDA(4.2,XMIENS,1.7)="y"
+18 ; Relay domain
SET XMFDA(4.2,XMIENS,2)=^XMB("PARENT")
+19 DO UPDATE^DIE("","XMFDA","XMIEN")
+20 ; If there's a problem with adding the top-level domain to the DOMAIN
+21 ; file, just pretend that we're talking to this site's parent.
+22 ; (TURN command will be disabled.)
+23 IF $DATA(DIERR)
QUIT ^XMB("PARENT")_U_$PIECE(^DIC(4.2,^XMB("PARENT"),0),U,1)
+24 ; Notify someone that we've added a new domain to the DOMAIN file.
+25 NEW XMINSTR,XMPARM
+26 SET XMPARM(1)=XMTOP
+27 SET XMPARM(2)=XMDOMAIN
+28 SET XMINSTR("FROM")="POSTMASTER"
+29 DO TASKBULL^XMXBULL(.5,"XM DOMAIN ADDED",.XMPARM,,,.XMINSTR)
+30 QUIT XMIEN(1)_U_XMTOP
VALPROC(XMINST,XMDOMREC,XMP,XMRVAL) ; Check validation number
+1 LOCK +^DIC(4.2,XMINST,0):0
IF '$TEST
SET XMSG="550 Domain file locked, try later"
XECUTE XMSEN
QUIT
+2 SET XMRVAL=$PIECE($PIECE(XMP,"<",2),">")
+3 DO VALCHK(.XMDOMREC,XMRVAL)
+4 IF '$DATA(XMRVAL)
LOCK -^DIC(4.2,XMINST,0)
QUIT
+5 ; generate new validation number
SET XMRVAL=$RANDOM(8000000)+1000000
+6 ;set val. num in return message, set new Val. num field
+7 SET $PIECE(XMDOMREC,U,18)=XMRVAL
+8 SET ^DIC(4.2,XMINST,0)=XMDOMREC
+9 QUIT
VALCHK(XMDOMREC,XMRVAL) ; Check the validation number
+1 ; 15=current number; 18=new number
IF XMRVAL=$PIECE(XMDOMREC,U,15)
QUIT
+2 IF XMRVAL=$PIECE(XMDOMREC,U,18)
SET $PIECE(XMDOMREC,U,15)=$PIECE(XMDOMREC,U,18)
QUIT
+3 KILL XMRVAL
+4 NEW XMPARM,XMINSTR
+5 SET XMINSTR("FROM")="POSTMASTER"
+6 SET XMPARM(1)=XMC("HELO RECV")
+7 DO TASKBULL^XMXBULL(.5,"XMVALBAD",.XMPARM,"","",.XMINSTR)
+8 SET XMSG="550 Bad validation number"
XECUTE XMSEN
+9 QUIT
VALSET(XMINST,XMRVAL) ;check validation number
+1 ;if new val. num. exist, then set val. num. to it and set to null
+2 IF '$GET(XMRVAL)
QUIT
+3 NEW XMDOMREC
+4 SET XMDOMREC=$GET(^DIC(4.2,XMINST,0))
+5 SET $PIECE(XMDOMREC,U,15)=XMRVAL
+6 SET $PIECE(XMDOMREC,U,18)=""
+7 SET ^DIC(4.2,XMINST,0)=XMDOMREC
+8 LOCK -^DIC(4.2,XMINST,0)
+9 KILL XMRVAL
+10 QUIT
MAIL ; Recv: "MAIL FROM:<USER.JOE@DOMAIN.NAME>"
+1 ; Send: "250 OK Message-ID:12345@DOMAIN.NAME"
+2 NEW XMD
+3 SET XMP=$PIECE(XMP,":",2,999)
+4 SET XMP=$$SCRUB^XMR3(XMP)
+5 IF XMP'?1"<>"
IF (XMP'?1"<"1.E1"@"1.E1">")
SET XMSG="501 Invalid reverse-path specification"
XECUTE XMSEN
QUIT
+6 IF $$REJECT(XMP)
SET XMSG="502 No message receipt authorization."
XECUTE XMSEN
QUIT
+7 KILL XMINSTR,XMNVFROM,XMREMID,XMRXMZ,XM2LONG,XMZ,XMZFDA,XMZIENS,^TMP("XMY",$JOB),^TMP("XMY0",$JOB)
+8 ; We're not sure who sent/forwarded it
SET XMINSTR("FWD BY")=""
+9 SET XMINSTR("ADDR FLAGS")="R"
+10 IF $DATA(XMERR)
KILL XMERR
IF $DATA(^TMP("XMERR",$JOB))
KILL ^TMP("XMERR",$JOB)
+11 ; * No Subject *
DO CRE8XMZ^XMXSEND($$EZBLD^DIALOG(34012),.XMZ)
+12 IF $DATA(XMERR)
Begin DoDot:1
+13 SET XMSG="555 "_^TMP("XMERR",$JOB,1,"TEXT",1)
+14 KILL XMERR,^TMP("XMERR",$JOB)
+15 XECUTE XMSEN
End DoDot:1
QUIT
+16 SET XMZIENS=XMZ_","
+17 ; mail from
SET (XMNVFROM,XMZFDA(3.9,XMZIENS,1),XMZFDA(3.9,XMZIENS,41))=XMP
+18 SET XMSTATE="^RCPT^DATA"
+19 ; Message date default
SET (XMD,XMZFDA(3.9,XMZIENS,1.4))=$$NOW^XLFDT()
+20 SET $PIECE(^XMB(3.9,XMZ,0),U,3)=XMD
+21 DO PUTMSG^XMXMSGS2(.5,.95,"ARRIVING",XMZ)
+22 SET XMSG="250 OK Message-ID:"_XMZ_"@"_^XMB("NETNAME")
XECUTE XMSEN
IF ER
QUIT
+23 SET XMD=$$INDT^XMXUTIL1(XMD)
+24 ;DON'T CHANGE ORDER OF .001 & .002 LINES !
+25 SET ^XMB(3.9,XMZ,2,.001,0)="Received: "_$SELECT($LENGTH($GET(XMC("HELO RECV"))):"from "_XMC("HELO RECV")_" by "_^XMB("NETNAME")_" (MailMan/"_$PIECE($TEXT(XMR1+1),";",3)_" "_XMPROT_")",1:"(BATCH)")_" id "_XMZ_" ; "_XMD
+26 NEW XMFDA,XMIENS
+27 SET XMIENS=XMINST_","
+28 SET XMFDA(4.2999,XMIENS,1)=$HOROLOG
+29 ; Message in transit
SET XMFDA(4.2999,XMIENS,2)=XMZ
+30 ;S XMFDA(4.2999,XMIENS,3)="@" ; Last line xmit'd
+31 DO FILE^DIE("","XMFDA")
+32 QUIT
REJECT(XMNVFROM) ; Check Senders rejected list
+1 IF '$ORDER(^XMBX(4.501,0))
QUIT 0
+2 NEW XMNO,XMREJECT,XMIEN,XMREC
+3 SET XMNVFROM=$$UP^XLFSTR(XMNVFROM)
+4 SET XMNO=""
SET XMREJECT=0
+5 FOR
SET XMNO=$ORDER(^XMBX(4.501,"B",XMNO))
IF XMNO=""
QUIT
Begin DoDot:1
+6 IF XMNVFROM'[$$UP^XLFSTR(XMNO)
QUIT
+7 SET XMIEN=$ORDER(^XMBX(4.501,"B",XMNO,0))
IF 'XMIEN
QUIT
+8 SET XMREC=$GET(^XMBX(4.501,XMIEN,0))
IF XMREC=""
QUIT
+9 IF XMNVFROM[$$UP^XLFSTR($PIECE(XMREC,U,1))
IF '$PIECE(XMREC,U,2)
SET XMREJECT=1
End DoDot:1
IF XMREJECT
QUIT
+10 QUIT XMREJECT
RCPT ; Specify recipients
+1 SET XMP=$PIECE(XMP,":",2,999)
IF XMP=""
SET XMSG="501 Invalid forward path specification"
XECUTE XMSEN
QUIT
+2 IF XMP["> FWD BY:"
SET XMINSTR("NET FWD BY")=$PIECE(XMP,"> FWD BY:",2)
+3 IF '$TEST
KILL XMINSTR("NET FWD BY")
+4 IF $$LOOKUP(XMP,.XMINSTR)=0
QUIT
+5 SET XMSG="250 'RCPT' accepted"
XECUTE XMSEN
+6 SET XMSTATE="^DATA^RCPT"
+7 QUIT
LOOKUP(XMTO,XMINSTR) ;
+1 NEW XMFULL,XMRESTR
+2 SET XMRESTR("NET RECEIVE")=$GET(XMNVFROM)
+3 ; I've seen <<user@site> and <<user@site>>
SET XMTO=$TRANSLATE($PIECE($PIECE(XMTO,">",1),"<",2,99),"<")
+4 IF XMTO=""
SET XMSG="550 Malformed address"
XECUTE XMSEN
QUIT 0
+5 IF $EXTRACT(XMTO,1)'=""""
IF XMTO?1"@"1.E1":"1.E1"@"1.E
SET XMTO=$PIECE(XMTO,":",2)
+6 DO CHKADDR^XMXADDR(.5,XMTO,.XMINSTR,.XMRESTR,.XMFULL)
+7 IF $DATA(XMERR)
Begin DoDot:1
+8 SET XMSG="550 "_^TMP("XMERR",$JOB,XMERR,"TEXT",1)
+9 XECUTE XMSEN
+10 KILL XMERR,^TMP("XMERR",$JOB)
End DoDot:1
QUIT 0
+11 IF $GET(XMFULL)="SHARED,MAIL"
Begin DoDot:1
+12 SET XMSG="550 'Shared,Mail' user may not receive network mail."
+13 XECUTE XMSEN
+14 KILL ^TMP("XMY",$JOB,.6),^TMP("XMY0",$JOB,"SHARED,MAIL")
End DoDot:1
QUIT 0
+15 ; Don't act as a relay domain for unauthorized sites.
+16 ; Local address OK
IF XMFULL'["@"
QUIT XMFULL
+17 ; Relay from accepted site
IF XMC("RELAY OK")
QUIT XMFULL
+18 NEW XMOKDOM,XMTRELAY
+19 SET XMTRELAY=$PIECE(XMFULL,"@",2)
+20 SET XMOKDOM=""
+21 FOR
SET XMOKDOM=$ORDER(XMC("MY DOMAIN",XMOKDOM))
IF XMOKDOM=""
QUIT
IF $FIND(XMTRELAY,XMOKDOM)=($LENGTH(XMTRELAY)+1)
QUIT
+22 ; Relay from an outside site to an inside site.
IF XMOKDOM'=""
QUIT XMFULL
+23 ; Relay from an outside site to an outside site.
+24 SET XMSG="550 Relaying denied."
+25 XECUTE XMSEN
+26 KILL ^TMP("XMY",$JOB,XMFULL),^TMP("XMY0",$JOB,XMFULL)
+27 ; Notify someone that a relay attempt was denied.
+28 NEW XMINSTR,XMPARM,XMTO
+29 SET XMPARM(1)=XMC("HELO RECV")
+30 SET XMPARM(2)=XMFULL
+31 SET XMPARM(3)=XMNVFROM
+32 SET XMINSTR("FROM")="POSTMASTER"
+33 SET XMTO(.5)=""
+34 DO TASKBULL^XMXBULL(.5,"XM RELAY ATTEMPTED",.XMPARM,,.XMTO,.XMINSTR)
+35 QUIT 0
