247 lines
8.9 KiB
Mathematica
247 lines
8.9 KiB
Mathematica
XMR3 ;ISC-SF/GMB-SMTP Receiver (RFC 822) ;07/01/2002 14:11
|
|
;;8.0;MailMan;;Jun 28, 2002
|
|
DATA ; TEXT / ASSUMES VALID RECIPIENT
|
|
; Incoming Variables:
|
|
; XMINSTR("FWD BY")=""
|
|
; XMZ message number of new message
|
|
; XMZFDA FM FDA for new message
|
|
; XMZIENS IENS for new message
|
|
; $D(XMC("DX")) means Test mode: Messages will not be delivered
|
|
; If the msg is from a VA site, the following may be set:
|
|
; XMREMID always set if the msg is from a VA site
|
|
; $G(XMRXMZ) message number of message we already have.
|
|
; Set if new message is a duplicate of one we already have.
|
|
N XMLIN,XMINCR,XMHDR,XMREJECT,XMSUBJ,XMFROM,XMDATE,XMENCR,XMZO,XMSENDER,XMREPLTO
|
|
D GETDATA Q:ER
|
|
I '$G(XMRXMZ),'$D(XMC("DX")) D HDRPROC Q:ER
|
|
I '$G(XMREJECT),'$D(XMC("DX")) D SET
|
|
S XMSTATE="^HELO^MAIL^"
|
|
K ^TMP("XMY",$J),^TMP("XMY0",$J)
|
|
D ZAPIT^XMXMSGS2(.5,.95,XMZ)
|
|
I '$G(XMREJECT) D
|
|
. S XMSG="250 'data' accepted" X XMSEN
|
|
. D XMTHIST^XMTDR(XMINST,"R",$P($G(^XMB(3.9,XMZ,2,0)),U,4))
|
|
K XMNVFROM,XMINSTR,XMREMID,XMRXMZ,XMZ,XMZIENS,XMZFDA
|
|
Q
|
|
GETDATA ;
|
|
N XMH
|
|
S XMSG="354 Enter data" X XMSEN Q:ER
|
|
S XMLIN=.001,XMINCR=.001,XMH=""
|
|
F X XMREC Q:ER Q:XMRG="." D
|
|
. I $E(XMRG)="." S XMRG=$E(XMRG,2,999)
|
|
. S XMLIN=XMLIN+XMINCR
|
|
. S ^XMB(3.9,XMZ,2,XMLIN,0)=XMRG
|
|
. Q:XMINCR=1
|
|
. I XMRG="" S XMINCR=1,XMLIN=0 Q
|
|
. I XMLIN=.99 S XMINCR=.000001
|
|
. I $E(XMRG,1)=" "!($E(XMRG,1)=$C(9)) Q:XMH="" D NEXT(XMH,.XMHDR,XMRG) Q
|
|
. ;I $E(XMRG,1)=" " Q:XMH="" D NEXT(XMH,.XMHDR,XMRG)
|
|
. S XMH=$$UP^XLFSTR($P(XMRG,":"))
|
|
. I "^DATE^FROM^IMPORTANCE^IN-REPLY-TO^MESSAGE-ID^SUBJECT^"[(U_XMH_U) S XMH=$E($TR(XMH,"-"),1,4),XMHDR(XMH)=$$SCRUB($P(XMRG,":",2,99)) Q
|
|
. I "^ENCRYPTED^EXPIRY-DATE^REFERENCES^REPLY-TO^RETURN-RECEIPT-TO^SENDER^SENSITIVITY^"[(U_XMH_U) S XMH=$E($TR(XMH,"-"),1,4),XMHDR(XMH)=$$SCRUB($P(XMRG,":",2,99)) Q
|
|
. I "^X-PRIORITY^"[(U_XMH_U) S XMH=$E($P(XMH,"-",2),1,4),XMHDR(XMH)=$$SCRUB($P(XMRG,":",2,99)) Q
|
|
. I "^X-MM-BASKET^X-MM-CLOSED^X-MM-INFO-ONLY^X-MM-TYPE^"[(U_XMH_U) S XMH=$E($P(XMH,"-",3),1,4),XMHDR(XMH)=$$SCRUB($P(XMRG,":",2,99)) Q
|
|
. S XMH=""
|
|
Q:ER
|
|
Q
|
|
NEXT(XMH,XMHDR,XMDATA) ;
|
|
N I
|
|
S XMDATA=$$SCRUB(XMDATA) Q:XMDATA=""
|
|
I XMHDR(XMH)="" S XMHDR(XMH)=XMDATA Q
|
|
I $L(XMHDR(XMH))+$L(XMDATA)<255 S XMHDR(XMH)=XMHDR(XMH)_" "_XMDATA Q
|
|
S I=$O(^XMHDR(XMH,":"),-1)+1
|
|
I $G(XMHDR(XMH,I))'="",$L(XMHDR(XMH,I))+$L(XMDATA)<255 S XMHDR(XMH,I)=$G(XMHDR(XMH,I))_" "_XMDATA Q
|
|
S XMHDR(XMH,I+1)=XMDATA
|
|
Q
|
|
HDRPROC ; Process header commands
|
|
N XMH,XMP,XMRINFO
|
|
I XMLIN,$O(^XMB(3.9,XMZ,2,XMLIN)) D Q
|
|
. S XMREJECT=1
|
|
. S XMSG="500 Synchronization Lost. Msg rejected." X XMSEN
|
|
. D KILLIT^XMR3A
|
|
;I '$D(XMHDR("FROM")) D Q
|
|
;. S XMREJECT=1
|
|
;. S XMSG="501 Missing FROM Header. Msg rejected." X XMSEN
|
|
;. D KILLIT^XMR3A
|
|
I $$TOOLONG D Q
|
|
. S XMREJECT=1
|
|
. S XMSG="551 Too many lines. Msg rejected." X XMSEN
|
|
. D KILLIT^XMR3A
|
|
I '$D(XMREMID) S XMREMID=""
|
|
S (XMH,XMZO,XMFROM,XMENCR,XMSENDER,XMDATE,XMSUBJ)=""
|
|
F S XMH=$O(XMHDR(XMH)) Q:XMH="" D
|
|
. S XMP=XMHDR(XMH)
|
|
. D @XMH
|
|
I '$O(^XMB(3.9,XMZ,2,.999999)),'$D(XMZFDA(3.9,XMZIENS,.01)) D Q
|
|
. S XMSG="552 No subject or text. Msg rejected." X XMSEN
|
|
. D KILLIT^XMR3A
|
|
. S XMREJECT=1
|
|
I $G(XMRINFO) D Q
|
|
. S XMSG="555 Reply to 'Info Only'. Msg rejected." X XMSEN
|
|
. D KILLIT^XMR3A
|
|
. S XMREJECT=1
|
|
;I $G(XMZFDA(3.9,XMZIENS,9))="" D Q
|
|
;. S XMSG="501 No MESSAGE-ID. Msg rejected." X XMSEN
|
|
;. D KILLIT^XMR3A
|
|
;. S XMREJECT=1
|
|
;I '$O(^XMB(3.9,XMZ,2,.999999)) S ^XMB(3.9,XMZ,2,1,0)=" "
|
|
S ^XMB(3.9,XMZ,2,0)="^^"_XMLIN_U_XMLIN
|
|
Q
|
|
TOOLONG() ;
|
|
N XMLIMIT
|
|
S XMLIMIT=$P($G(^XMB(1,1,"NETWORK-LIMIT")),U,2)
|
|
Q:'XMLIMIT 0
|
|
Q:$G(XM2LONG) 1
|
|
Q:XMLIN'>XMLIMIT 0
|
|
I $G(XMHDR("TYPE"))["X"!($G(XMHDR("TYPE"))["K") Q 0
|
|
Q 1
|
|
SCRUB(X) ; Strip ctrl chars and leading/trailing blanks
|
|
S:X?.E1C.E X=$$CTRL^XMXUTIL1(X)
|
|
S:$E(X,1)=" "!($E(X,$L(X))=" ") X=$$STRIP^XMXUTIL1(X)
|
|
Q X
|
|
BASK ; "X-MM-BASKET:" (Delivery Basket)
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,21)=XMP
|
|
Q
|
|
CLOS ; "X-MM-CLOSED:YES"
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.95)="y"
|
|
Q
|
|
DATE ; "DATE:"
|
|
S XMDATE=XMP
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.4)=XMDATE
|
|
Q
|
|
ENCR ; "ENCRYPT:"
|
|
S XMENCR=XMP
|
|
Q:'$D(XMZIENS)
|
|
S XMZFDA(3.9,XMZIENS,1.8)=$P(XMENCR,U,1) ; scramble hint
|
|
S XMZFDA(3.9,XMZIENS,1.85)=$P(XMENCR,U,2,999) ; scramble key
|
|
Q
|
|
EXPI ; "EXPIRY-DATE:" (vaporize date)
|
|
N XMVAPOR
|
|
S XMVAPOR=$$CONVERT^XMXUTIL1(XMP,1) Q:XMVAPOR=-1
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.6)=XMVAPOR
|
|
Q
|
|
FROM ; "FROM:"
|
|
S XMFROM=XMP
|
|
Q:'$D(XMZIENS)
|
|
;I $D(XMHDR("FROM",1)) D CONTINU(.XMFROM,"FROM",.XMHDR)
|
|
S XMZFDA(3.9,XMZIENS,1)=XMFROM
|
|
Q
|
|
CONTINU(XMVBL,XMH,XMHDR) ;
|
|
N I
|
|
S I=0
|
|
F S I=$O(XMHDR(XMH,I)) Q:'I S XMVBL=XMVBL_" "_XMHDR(XMH,I)
|
|
Q
|
|
IMPO ; "IMPORTANCE:HIGH" (Priority)
|
|
I $$UP^XLFSTR(XMP)'="HIGH"!'$D(XMZIENS) Q
|
|
S:$G(XMZFDA(3.9,XMZIENS,1.7))'["P" XMZFDA(3.9,XMZIENS,1.7)=$G(XMZFDA(3.9,XMZIENS,1.7))_"P"
|
|
Q
|
|
INFO ; "X-MM-INFO-ONLY:YES"
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.97)="y"
|
|
Q
|
|
REFE ; "REFERENCES:" (used by some systems, instead of 'in-reply-to')
|
|
Q
|
|
INRE ; "IN-REPLY-TO:" message at this site
|
|
N I,XMLOCID,XMREC
|
|
S XMLOCID=$$REMID(XMP)
|
|
S XMZO=$$LOCALXMZ^XMR3A(XMLOCID)
|
|
Q:'XMZO
|
|
I $P(XMZO,U,3)'="E" S XMZO="" Q
|
|
S XMZO=+XMZO
|
|
S XMREC=$G(^XMB(3.9,XMZO,0))
|
|
I $P(XMREC,U,8) D ; If reply to a reply, get original msg #
|
|
. S XMZO=$P(XMREC,U,8)
|
|
. S XMREC=$G(^XMB(3.9,XMZO,0))
|
|
I XMREC="" S XMZO="" Q ; Original message not found, so make this reply a message.
|
|
I "^y^Y^"[(U_$P(XMREC,U,12)_U) S XMRINFO=1 Q ; Reply to 'info only' msg
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.35)=XMZO ; Point from response to original msg
|
|
Q
|
|
REMID(X) ;
|
|
Q:X["<" $TR($P(X,">",1),"<")
|
|
; I've seen some like this: "<<...>>"
|
|
; I've seen some like this: "<...>; comment here"
|
|
Q X
|
|
MESS ; "MESSAGE-ID:" at site where message originated
|
|
S XMREMID=$$REMID(XMP)
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,9)=XMREMID
|
|
Q
|
|
PRIO ; "X-PRIORITY:1" (Priority)
|
|
I $$UP^XLFSTR(XMP)'=1!'$D(XMZIENS) Q
|
|
S:$G(XMZFDA(3.9,XMZIENS,1.7))'["P" XMZFDA(3.9,XMZIENS,1.7)=$G(XMZFDA(3.9,XMZIENS,1.7))_"P"
|
|
Q
|
|
REPL ; "REPLY-TO:"
|
|
S XMREPLTO=XMP
|
|
;I $D(XMHDR("REPL",1)) D CONTINU(.XMREPLTO,"REPL",.XMHDR)
|
|
Q
|
|
RETU ; "RETURN-RECEIPT-TO:"
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.3)="y"
|
|
Q
|
|
SEND ; "SENDER:" (Surrogate)
|
|
S XMSENDER=XMP
|
|
;I $D(XMHDR("SEND",1)) D CONTINU(.XMSENDER,"SEND",.XMHDR)
|
|
Q:XMSENDER=$G(XMFROM)
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.1)=XMSENDER
|
|
Q
|
|
SENS ; "SENSITIVITY:PERSONAL" (Confidential)
|
|
Q:"^PERSONAL^PRIVATE^COMPANY-CONFIDENTIAL^"'[(U_$$UP^XLFSTR(XMP)_U)
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.96)="y"
|
|
Q
|
|
SUBJ ; "SUBJECT:"
|
|
S XMSUBJ=XMP
|
|
I XMSUBJ[" " S XMSUBJ=$$MAXBLANK^XMXUTIL1(XMSUBJ)
|
|
I XMSUBJ["^" S XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
|
|
S XMSUBJ=$E(XMSUBJ,1,65)
|
|
Q:XMSUBJ=""!'$D(XMZIENS)
|
|
I $L(XMSUBJ)<3 S XMSUBJ="..."
|
|
S XMZFDA(3.9,XMZIENS,.01)=XMSUBJ
|
|
Q
|
|
TYPE ; "X-MM-TYPE:"
|
|
S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.7)=XMP
|
|
Q
|
|
SET ; Set data into message file
|
|
I $G(XMREMID)'="" D CHEKDUP^XMR3A Q:$G(XMREJECT)
|
|
I $D(XMZFDA) D
|
|
. I $D(XMZFDA(3.9,XMZIENS,1.1)),$L(XMZFDA(3.9,XMZIENS,1))+$L(XMZFDA(3.9,XMZIENS,1.1))>130 S XMZFDA(3.9,XMZIENS,1.1)=$E($$REMADDR^XMXADDR3(XMZFDA(3.9,XMZIENS,1.1)),1,64)
|
|
. I $L(XMZFDA(3.9,XMZIENS,1))>100 S XMZFDA(3.9,XMZIENS,1)="<"_$$REMADDR^XMXADDR3(XMZFDA(3.9,XMZIENS,1))_">"
|
|
. D FILE^DIE("","XMZFDA")
|
|
;SENDER only RCPT / REMOTE sender drops thru (local>0=pointer)
|
|
I $G(XMZO) D Q:$O(^TMP("XMY",$J,"")) ; I don't understand this.
|
|
. D DOTRAN^XMC1(42315,XMZ,XMZO) ;> Putting response |1| into message |2|
|
|
. D DOTRAN^XMC1(42316,XMZO) ;> Delivering message |1|
|
|
. D RPOST^XMKP("NR",XMZO,XMZ)
|
|
D FWD^XMKP(.5,XMZ,.XMINSTR)
|
|
D CHECK^XMKPL
|
|
Q
|
|
PARSE(XMZ,XMREMID,XMSUBJ,XMFROM,XMDATE,XMSENDER,XMENCR,XMZO) ; Get data for remotely originated message
|
|
; This is used by ^XMRENT & ^XMS3
|
|
; XMSUBJ subject
|
|
; XMFROM from
|
|
; XMDATE date
|
|
; XMENCR scramble hint "^" scramble key
|
|
; XMREMID message id at site where msg originated (not necessarily at the sending site)
|
|
; XMZO original message xmz (to which this msg is a response)
|
|
N XMP,XMH,XMHDR,XMRINFO,XMZFDA,XMZIENS,XMFIND
|
|
; Don't add anything to this list:
|
|
S XMFIND="^DATE^ENCRYPTED^FROM^IN-REPLY-TO^MESSAGE-ID^SENDER^SUBJECT^"
|
|
D HDRFIND(XMZ,XMFIND,.XMHDR)
|
|
S XMH=""
|
|
F S XMH=$O(XMHDR(XMH)) Q:XMH="" D
|
|
. S XMP=XMHDR(XMH)
|
|
. D @XMH
|
|
Q
|
|
HDRFIND(XMZ,XMFIND,XMHDR) ;
|
|
N XMH,XMI,XMREC
|
|
I XMFIND'?1"^".E1"^" D
|
|
. I $E(XMFIND,1)'=U S XMFIND=U_XMFIND
|
|
. I $E(XMFIND,$L(XMFIND))'=U S XMFIND=XMFIND_U
|
|
S XMI=0
|
|
F S XMI=$O(^XMB(3.9,XMZ,2,XMI)) Q:XMI'<1!'XMI S XMREC=^(XMI,0) Q:XMREC="" D
|
|
. I $E(XMREC,1)=" "!($E(XMREC,1)=$C(9)) Q:XMH="" D NEXT(XMH,.XMHDR,XMREC) Q
|
|
. S XMH=$$UP^XLFSTR($P(XMREC,":"))
|
|
. I XMFIND'[(U_XMH_U) S XMH="" Q
|
|
. I "^DATE^FROM^IMPORTANCE^IN-REPLY-TO^MESSAGE-ID^SUBJECT^"[(U_XMH_U) S XMH=$E($TR(XMH,"-"),1,4),XMHDR(XMH)=$$SCRUB($P(XMREC,":",2,99)) Q
|
|
. I "^ENCRYPTED^EXPIRY-DATE^REFERENCES^REPLY-TO^RETURN-RECEIPT-TO^SENDER^SENSITIVITY^"[(U_XMH_U) S XMH=$E($TR(XMH,"-"),1,4),XMHDR(XMH)=$$SCRUB($P(XMREC,":",2,99)) Q
|
|
. I "^X-PRIORITY^"[(U_XMH_U) S XMH=$E($P(XMH,"-",2),1,4),XMHDR(XMH)=$$SCRUB($P(XMREC,":",2,99)) Q
|
|
. I "^X-MM-BASKET^X-MM-CLOSED^X-MM-INFO-ONLY^X-MM-TYPE^"[(U_XMH_U) S XMH=$E($P(XMH,"-",3),1,4),XMHDR(XMH)=$$SCRUB($P(XMREC,":",2,99)) Q
|
|
. S XMH=""
|
|
Q
|