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

XMR1.m

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