| 1 | XMR1 ;ISC-SF/GMB-SMTP Receiver HELO/MAIL/RCPT (RFC 821) ;02/10/2004 06:31
|
|---|
| 2 | ;;8.0;MailMan;**6,24**;Jun 28, 2002
|
|---|
| 3 | HELO ; Recv: "HELO REMOTE.MED.VA.GOV <security num>"
|
|---|
| 4 | ; Send: "250 OK LOCAL.MED.VA.GOV <security num> [8.0,DUP,SER,FTP]"
|
|---|
| 5 | N X,Y,XMDOMREC
|
|---|
| 6 | I XMP="" S XMSG="501 Missing domain specification" X XMSEN Q
|
|---|
| 7 | I '$D(^XMB("NETNAME")) S XMSG="550 Unchristened local domain" X XMSEN Q
|
|---|
| 8 | S X=$P(XMP,"<")
|
|---|
| 9 | I $E(X,$L(X))="." S XMSG="501 Invalid Domain Name" X XMSEN Q
|
|---|
| 10 | S XMSTATE="^HELO^QUIT^"
|
|---|
| 11 | S X=$$UP^XLFSTR(X)
|
|---|
| 12 | S Y=$$FACILITY(X)
|
|---|
| 13 | I Y>0 D
|
|---|
| 14 | . S XMINST=+Y
|
|---|
| 15 | . S (XMSITE,XMC("HELO RECV"))=$P(Y,U,2)
|
|---|
| 16 | E I $$REJECT(X) D Q
|
|---|
| 17 | . S XMSG="421 Service not available, closing transmission channel" X XMSEN
|
|---|
| 18 | . S XMC("QUIT")=1
|
|---|
| 19 | E D
|
|---|
| 20 | . S XMC("HELO RECV")=X
|
|---|
| 21 | . S Y=$$DOMAIN(X)
|
|---|
| 22 | . S XMINST=+Y
|
|---|
| 23 | . S XMSITE=$P(Y,U,2)
|
|---|
| 24 | I +$G(^XMB(1,1,4)) D
|
|---|
| 25 | . D NORELAY
|
|---|
| 26 | E S XMC("RELAY OK")=1
|
|---|
| 27 | I XMC("BATCH") S XMSTATE="^MAIL^",XMCONT=XMCONT_"TURN^MESS^" Q
|
|---|
| 28 | S XMDOMREC=^DIC(4.2,XMINST,0)
|
|---|
| 29 | I $P(XMDOMREC,U,15) D VALPROC(XMINST,XMDOMREC,XMP,.XMRVAL) Q:'$D(XMRVAL)
|
|---|
| 30 | S XMSG="250 OK "_^XMB("NETNAME")_$S($D(XMRVAL):" <"_XMRVAL_">",1:"")_" ["_$P($T(XMR1+1),";",3)_",DUP,SER,FTP]" X XMSEN
|
|---|
| 31 | S XMSTATE="^MAIL^",XMCONT=XMCONT_"TURN^MESS^"
|
|---|
| 32 | Q
|
|---|
| 33 | NORELAY ; We want to prevent this site from unwittingly acting as a relay
|
|---|
| 34 | ; domain for spammers or viruses. Such nefarious ne'erdowells
|
|---|
| 35 | ; typically route their mail through unsuspecting sites to "launder"
|
|---|
| 36 | ; it. The unsuspecting sites forward it onward.
|
|---|
| 37 | ; XMC("HELO RECV") contains the sending site's name. If we
|
|---|
| 38 | ; were to be truly vigorous about this, we would find out the IP
|
|---|
| 39 | ; address of the site and do a reverse DNS lookup to verify the site's
|
|---|
| 40 | ; name. We don't yet have that capability, so we'll have to make do
|
|---|
| 41 | ; with XMC("HELO RECV") and trust that the site is who it says it is.
|
|---|
| 42 | N XMOKDOM
|
|---|
| 43 | S XMOKDOM="" ; Get list of acceptable sites
|
|---|
| 44 | F S XMOKDOM=$O(^XMB(1,1,4.1,"B",XMOKDOM)) Q:XMOKDOM="" D
|
|---|
| 45 | . S XMC("MY DOMAIN",$$UP^XLFSTR(XMOKDOM))=""
|
|---|
| 46 | I $F(^XMB("NETNAME"),".VA.GOV")=($L(^XMB("NETNAME"))+1) D
|
|---|
| 47 | . ; This is a VA site. Make sure mail from other VA sites is relayed.
|
|---|
| 48 | . I '$D(XMC("MY DOMAIN",".VA.GOV")) S XMC("MY DOMAIN",^XMB("NETNAME"))=""
|
|---|
| 49 | S XMOKDOM="" ; Make sure this site is an acceptable site!
|
|---|
| 50 | F S XMOKDOM=$O(XMC("MY DOMAIN",XMOKDOM)) Q:XMOKDOM="" Q:$F(^XMB("NETNAME"),XMOKDOM)=($L(^XMB("NETNAME"))+1)
|
|---|
| 51 | I XMOKDOM="" S XMC("MY DOMAIN",^XMB("NETNAME"))="" ; Default
|
|---|
| 52 | ; Set XMC("RELAY OK")=1 if the sending site is acceptable.
|
|---|
| 53 | S XMOKDOM=""
|
|---|
| 54 | F S XMOKDOM=$O(XMC("MY DOMAIN",XMOKDOM)) Q:XMOKDOM="" Q:$F(XMC("HELO RECV"),XMOKDOM)=($L(XMC("HELO RECV"))+1)
|
|---|
| 55 | S XMC("RELAY OK")=XMOKDOM'=""
|
|---|
| 56 | Q
|
|---|
| 57 | FACILITY(X) ; If full domain name is found in domain file, either as main
|
|---|
| 58 | ; entry or as synonym, return main entry. "Domain IEN^Domain name"
|
|---|
| 59 | N DIC,Y,D
|
|---|
| 60 | S DIC="^DIC(4.2,",DIC(0)="FMOZ",D="B^C"
|
|---|
| 61 | D MIX^DIC1
|
|---|
| 62 | Q $S(Y>0:+Y_U_Y(0,0),1:Y)
|
|---|
| 63 | DOMAIN(XMDOMAIN) ; Try to find the domain.
|
|---|
| 64 | N DIC,X,Y,D
|
|---|
| 65 | S (X,XMDOMAIN)=$$UP^XLFSTR(XMDOMAIN)
|
|---|
| 66 | S DIC="^DIC(4.2,",DIC(0)="FMXZ",D="B^C"
|
|---|
| 67 | F D MIX^DIC1 Q:Y>0!(X'[".") S X=$P(X,".",2,99)
|
|---|
| 68 | Q:Y>0 +Y_U_Y(0,0)
|
|---|
| 69 | N XMTOP
|
|---|
| 70 | S XMTOP=X
|
|---|
| 71 | ; If the top-level domain is found in the Internet Suffix file, then
|
|---|
| 72 | ; just pretend that we're talking to this site's parent.
|
|---|
| 73 | ; (TURN command will be disabled.)
|
|---|
| 74 | I $$FIND1^DIC(4.2996,"","QX",XMTOP) Q ^XMB("PARENT")_U_$P(^DIC(4.2,^XMB("PARENT"),0),U,1)
|
|---|
| 75 | ; Add the top-level domain to the DOMAIN file.
|
|---|
| 76 | N XMFDA,XMIENS,XMIEN
|
|---|
| 77 | S XMIENS="?+1,"
|
|---|
| 78 | S XMFDA(4.2,XMIENS,.01)=XMTOP ; Top-level domain name
|
|---|
| 79 | S XMFDA(4.2,XMIENS,1)="C" ; Closed
|
|---|
| 80 | S XMFDA(4.2,XMIENS,1.7)="y" ; Disable TURN command
|
|---|
| 81 | S XMFDA(4.2,XMIENS,2)=^XMB("PARENT") ; Relay domain
|
|---|
| 82 | D UPDATE^DIE("","XMFDA","XMIEN")
|
|---|
| 83 | ; If there's a problem with adding the top-level domain to the DOMAIN
|
|---|
| 84 | ; file, just pretend that we're talking to this site's parent.
|
|---|
| 85 | ; (TURN command will be disabled.)
|
|---|
| 86 | I $D(DIERR) Q ^XMB("PARENT")_U_$P(^DIC(4.2,^XMB("PARENT"),0),U,1)
|
|---|
| 87 | ; Notify someone that we've added a new domain to the DOMAIN file.
|
|---|
| 88 | N XMINSTR,XMPARM
|
|---|
| 89 | S XMPARM(1)=XMTOP
|
|---|
| 90 | S XMPARM(2)=XMDOMAIN
|
|---|
| 91 | S XMINSTR("FROM")="POSTMASTER"
|
|---|
| 92 | D TASKBULL^XMXBULL(.5,"XM DOMAIN ADDED",.XMPARM,,,.XMINSTR)
|
|---|
| 93 | Q XMIEN(1)_U_XMTOP
|
|---|
| 94 | VALPROC(XMINST,XMDOMREC,XMP,XMRVAL) ; Check validation number
|
|---|
| 95 | L +^DIC(4.2,XMINST,0):0 E S XMSG="550 Domain file locked, try later" X XMSEN Q
|
|---|
| 96 | S XMRVAL=$P($P(XMP,"<",2),">")
|
|---|
| 97 | D VALCHK(.XMDOMREC,XMRVAL)
|
|---|
| 98 | I '$D(XMRVAL) L -^DIC(4.2,XMINST,0) Q
|
|---|
| 99 | S XMRVAL=$R(8000000)+1000000 ; generate new validation number
|
|---|
| 100 | ;set val. num in return message, set new Val. num field
|
|---|
| 101 | S $P(XMDOMREC,U,18)=XMRVAL
|
|---|
| 102 | S ^DIC(4.2,XMINST,0)=XMDOMREC
|
|---|
| 103 | Q
|
|---|
| 104 | VALCHK(XMDOMREC,XMRVAL) ; Check the validation number
|
|---|
| 105 | Q:XMRVAL=$P(XMDOMREC,U,15) ; 15=current number; 18=new number
|
|---|
| 106 | I XMRVAL=$P(XMDOMREC,U,18) S $P(XMDOMREC,U,15)=$P(XMDOMREC,U,18) Q
|
|---|
| 107 | K XMRVAL
|
|---|
| 108 | N XMPARM,XMINSTR
|
|---|
| 109 | S XMINSTR("FROM")="POSTMASTER"
|
|---|
| 110 | S XMPARM(1)=XMC("HELO RECV")
|
|---|
| 111 | D TASKBULL^XMXBULL(.5,"XMVALBAD",.XMPARM,"","",.XMINSTR)
|
|---|
| 112 | S XMSG="550 Bad validation number" X XMSEN
|
|---|
| 113 | Q
|
|---|
| 114 | VALSET(XMINST,XMRVAL) ;check validation number
|
|---|
| 115 | ;if new val. num. exist, then set val. num. to it and set to null
|
|---|
| 116 | Q:'$G(XMRVAL)
|
|---|
| 117 | N XMDOMREC
|
|---|
| 118 | S XMDOMREC=$G(^DIC(4.2,XMINST,0))
|
|---|
| 119 | S $P(XMDOMREC,U,15)=XMRVAL
|
|---|
| 120 | S $P(XMDOMREC,U,18)=""
|
|---|
| 121 | S ^DIC(4.2,XMINST,0)=XMDOMREC
|
|---|
| 122 | L -^DIC(4.2,XMINST,0)
|
|---|
| 123 | K XMRVAL
|
|---|
| 124 | Q
|
|---|
| 125 | MAIL ; Recv: "MAIL FROM:<USER.JOE@REMOTE.MED.VA.GOV>"
|
|---|
| 126 | ; Send: "250 OK Message-ID:12345@LOCAL.MED.VA.GOV"
|
|---|
| 127 | N XMD
|
|---|
| 128 | S XMP=$P(XMP,":",2,999)
|
|---|
| 129 | S XMP=$$SCRUB^XMR3(XMP)
|
|---|
| 130 | I XMP'?1"<>",(XMP'?1"<"1.E1"@"1.E1">") S XMSG="501 Invalid reverse-path specification" X XMSEN Q
|
|---|
| 131 | I $$REJECT(XMP) S XMSG="502 No message receipt authorization." X XMSEN Q
|
|---|
| 132 | K XMINSTR,XMNVFROM,XMREMID,XMRXMZ,XM2LONG,XMZ,XMZFDA,XMZIENS,^TMP("XMY",$J),^TMP("XMY0",$J)
|
|---|
| 133 | S XMINSTR("FWD BY")="" ; We're not sure who sent/forwarded it
|
|---|
| 134 | S XMINSTR("ADDR FLAGS")="R"
|
|---|
| 135 | K:$D(XMERR) XMERR K:$D(^TMP("XMERR",$J)) ^TMP("XMERR",$J)
|
|---|
| 136 | D CRE8XMZ^XMXSEND($$EZBLD^DIALOG(34012),.XMZ) ; * No Subject *
|
|---|
| 137 | I $D(XMERR) D Q
|
|---|
| 138 | . S XMSG="555 "_^TMP("XMERR",$J,1,"TEXT",1)
|
|---|
| 139 | . K XMERR,^TMP("XMERR",$J)
|
|---|
| 140 | . X XMSEN
|
|---|
| 141 | S XMZIENS=XMZ_","
|
|---|
| 142 | S (XMNVFROM,XMZFDA(3.9,XMZIENS,1),XMZFDA(3.9,XMZIENS,41))=XMP ; mail from
|
|---|
| 143 | S XMSTATE="^RCPT^DATA"
|
|---|
| 144 | S (XMD,XMZFDA(3.9,XMZIENS,1.4))=$$NOW^XLFDT() ; Message date default
|
|---|
| 145 | S $P(^XMB(3.9,XMZ,0),U,3)=XMD
|
|---|
| 146 | D PUTMSG^XMXMSGS2(.5,.95,"ARRIVING",XMZ)
|
|---|
| 147 | S XMSG="250 OK Message-ID:"_XMZ_"@"_^XMB("NETNAME") X XMSEN Q:ER
|
|---|
| 148 | S XMD=$$INDT^XMXUTIL1(XMD)
|
|---|
| 149 | ;DON'T CHANGE ORDER OF .001 & .002 LINES !
|
|---|
| 150 | 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
|
|---|
| 151 | N XMFDA,XMIENS
|
|---|
| 152 | S XMIENS=XMINST_","
|
|---|
| 153 | S XMFDA(4.2999,XMIENS,1)=$H
|
|---|
| 154 | S XMFDA(4.2999,XMIENS,2)=XMZ ; Message in transit
|
|---|
| 155 | ;S XMFDA(4.2999,XMIENS,3)="@" ; Last line xmit'd
|
|---|
| 156 | D FILE^DIE("","XMFDA")
|
|---|
| 157 | Q
|
|---|
| 158 | REJECT(XMNVFROM) ; Check Senders rejected list
|
|---|
| 159 | Q:'$O(^XMBX(4.501,0)) 0
|
|---|
| 160 | N XMNO,XMREJECT,XMIEN,XMREC
|
|---|
| 161 | S XMNVFROM=$$UP^XLFSTR(XMNVFROM)
|
|---|
| 162 | S XMNO="",XMREJECT=0
|
|---|
| 163 | F S XMNO=$O(^XMBX(4.501,"B",XMNO)) Q:XMNO="" D Q:XMREJECT
|
|---|
| 164 | . Q:XMNVFROM'[$$UP^XLFSTR(XMNO)
|
|---|
| 165 | . S XMIEN=$O(^XMBX(4.501,"B",XMNO,0)) Q:'XMIEN
|
|---|
| 166 | . S XMREC=$G(^XMBX(4.501,XMIEN,0)) Q:XMREC=""
|
|---|
| 167 | . I XMNVFROM[$$UP^XLFSTR($P(XMREC,U,1)),'$P(XMREC,U,2) S XMREJECT=1
|
|---|
| 168 | Q XMREJECT
|
|---|
| 169 | RCPT ; Specify recipients
|
|---|
| 170 | S XMP=$P(XMP,":",2,999) I XMP="" S XMSG="501 Invalid forward path specification" X XMSEN Q
|
|---|
| 171 | I XMP["> FWD BY:" S XMINSTR("NET FWD BY")=$P(XMP,"> FWD BY:",2)
|
|---|
| 172 | E K XMINSTR("NET FWD BY")
|
|---|
| 173 | Q:$$LOOKUP(XMP,.XMINSTR)=0
|
|---|
| 174 | S XMSG="250 'RCPT' accepted" X XMSEN
|
|---|
| 175 | S XMSTATE="^DATA^RCPT"
|
|---|
| 176 | Q
|
|---|
| 177 | LOOKUP(XMTO,XMINSTR) ;
|
|---|
| 178 | N XMFULL,XMRESTR
|
|---|
| 179 | S XMRESTR("NET RECEIVE")=$G(XMNVFROM)
|
|---|
| 180 | S XMTO=$TR($P($P(XMTO,">",1),"<",2,99),"<") ; I've seen <<user@site> and <<user@site>>
|
|---|
| 181 | I XMTO="" S XMSG="550 Malformed address" X XMSEN Q 0
|
|---|
| 182 | I $E(XMTO,1)'="""",XMTO?1"@"1.E1":"1.E1"@"1.E S XMTO=$P(XMTO,":",2)
|
|---|
| 183 | D CHKADDR^XMXADDR(.5,XMTO,.XMINSTR,.XMRESTR,.XMFULL)
|
|---|
| 184 | I $D(XMERR) D Q 0
|
|---|
| 185 | . S XMSG="550 "_^TMP("XMERR",$J,XMERR,"TEXT",1)
|
|---|
| 186 | . X XMSEN
|
|---|
| 187 | . K XMERR,^TMP("XMERR",$J)
|
|---|
| 188 | I $G(XMFULL)="SHARED,MAIL" D Q 0
|
|---|
| 189 | . S XMSG="550 'Shared,Mail' user may not receive network mail."
|
|---|
| 190 | . X XMSEN
|
|---|
| 191 | . K ^TMP("XMY",$J,.6),^TMP("XMY0",$J,"SHARED,MAIL")
|
|---|
| 192 | ; Don't act as a relay domain for unauthorized sites.
|
|---|
| 193 | I XMFULL'["@" Q XMFULL ; Local address OK
|
|---|
| 194 | I XMC("RELAY OK") Q XMFULL ; Relay from accepted site
|
|---|
| 195 | N XMOKDOM,XMTRELAY
|
|---|
| 196 | S XMTRELAY=$P(XMFULL,"@",2)
|
|---|
| 197 | S XMOKDOM=""
|
|---|
| 198 | F S XMOKDOM=$O(XMC("MY DOMAIN",XMOKDOM)) Q:XMOKDOM="" Q:$F(XMTRELAY,XMOKDOM)=($L(XMTRELAY)+1)
|
|---|
| 199 | I XMOKDOM'="" Q XMFULL ; Relay from an outside site to an inside site.
|
|---|
| 200 | ; Relay from an outside site to an outside site.
|
|---|
| 201 | S XMSG="550 Relaying denied."
|
|---|
| 202 | X XMSEN
|
|---|
| 203 | K ^TMP("XMY",$J,XMFULL),^TMP("XMY0",$J,XMFULL)
|
|---|
| 204 | ; Notify someone that a relay attempt was denied.
|
|---|
| 205 | N XMINSTR,XMPARM,XMTO
|
|---|
| 206 | S XMPARM(1)=XMC("HELO RECV")
|
|---|
| 207 | S XMPARM(2)=XMFULL
|
|---|
| 208 | S XMPARM(3)=XMNVFROM
|
|---|
| 209 | S XMINSTR("FROM")="POSTMASTER"
|
|---|
| 210 | S XMTO(.5)=""
|
|---|
| 211 | D TASKBULL^XMXBULL(.5,"XM RELAY ATTEMPTED",.XMPARM,,.XMTO,.XMINSTR)
|
|---|
| 212 | Q 0
|
|---|
