213 lines
8.7 KiB
Mathematica
213 lines
8.7 KiB
Mathematica
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 LOCAL.MED.VA.GOV <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@REMOTE.MED.VA.GOV>"
|
|
; Send: "250 OK Message-ID:12345@LOCAL.MED.VA.GOV"
|
|
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
|