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

XMR3.m

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