- 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.DOMAIN.EXT <security num>"
- ; Send: "250 OK LOCAL.DOMAIN.EXT <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"),".DOMAIN.EXT")=($L(^XMB("NETNAME"))+1) D
- . ; This is a VA site. Make sure mail from other VA sites is relayed.
- . I '$D(XMC("MY DOMAIN",".DOMAIN.EXT")) 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.DOMAIN.EXT>"
- ; Send: "250 OK Message-ID:12345@LOCAL.DOMAIN.EXT"
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMR1 9151 printed Jan 18, 2025@03:13:54 Page 2
- 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.DOMAIN.EXT <security num>"
- +1 ; Send: "250 OK LOCAL.DOMAIN.EXT <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"),".DOMAIN.EXT")=($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",".DOMAIN.EXT"))
- 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@REMOTE.DOMAIN.EXT>"
- +1 ; Send: "250 OK Message-ID:12345@LOCAL.DOMAIN.EXT"
- +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