source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMR3.m@ 823

Last change on this file since 823 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.9 KB
Line 
1XMR3 ;ISC-SF/GMB-SMTP Receiver (RFC 822) ;07/01/2002 14:11
2 ;;8.0;MailMan;;Jun 28, 2002
3DATA ; TEXT / ASSUMES VALID RECIPIENT
4 ; Incoming Variables:
5 ; XMINSTR("FWD BY")=""
6 ; XMZ message number of new message
7 ; XMZFDA FM FDA for new message
8 ; XMZIENS IENS for new message
9 ; $D(XMC("DX")) means Test mode: Messages will not be delivered
10 ; If the msg is from a VA site, the following may be set:
11 ; XMREMID always set if the msg is from a VA site
12 ; $G(XMRXMZ) message number of message we already have.
13 ; Set if new message is a duplicate of one we already have.
14 N XMLIN,XMINCR,XMHDR,XMREJECT,XMSUBJ,XMFROM,XMDATE,XMENCR,XMZO,XMSENDER,XMREPLTO
15 D GETDATA Q:ER
16 I '$G(XMRXMZ),'$D(XMC("DX")) D HDRPROC Q:ER
17 I '$G(XMREJECT),'$D(XMC("DX")) D SET
18 S XMSTATE="^HELO^MAIL^"
19 K ^TMP("XMY",$J),^TMP("XMY0",$J)
20 D ZAPIT^XMXMSGS2(.5,.95,XMZ)
21 I '$G(XMREJECT) D
22 . S XMSG="250 'data' accepted" X XMSEN
23 . D XMTHIST^XMTDR(XMINST,"R",$P($G(^XMB(3.9,XMZ,2,0)),U,4))
24 K XMNVFROM,XMINSTR,XMREMID,XMRXMZ,XMZ,XMZIENS,XMZFDA
25 Q
26GETDATA ;
27 N XMH
28 S XMSG="354 Enter data" X XMSEN Q:ER
29 S XMLIN=.001,XMINCR=.001,XMH=""
30 F X XMREC Q:ER Q:XMRG="." D
31 . I $E(XMRG)="." S XMRG=$E(XMRG,2,999)
32 . S XMLIN=XMLIN+XMINCR
33 . S ^XMB(3.9,XMZ,2,XMLIN,0)=XMRG
34 . Q:XMINCR=1
35 . I XMRG="" S XMINCR=1,XMLIN=0 Q
36 . I XMLIN=.99 S XMINCR=.000001
37 . I $E(XMRG,1)=" "!($E(XMRG,1)=$C(9)) Q:XMH="" D NEXT(XMH,.XMHDR,XMRG) Q
38 . ;I $E(XMRG,1)=" " Q:XMH="" D NEXT(XMH,.XMHDR,XMRG)
39 . S XMH=$$UP^XLFSTR($P(XMRG,":"))
40 . 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
41 . 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
42 . I "^X-PRIORITY^"[(U_XMH_U) S XMH=$E($P(XMH,"-",2),1,4),XMHDR(XMH)=$$SCRUB($P(XMRG,":",2,99)) Q
43 . 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
44 . S XMH=""
45 Q:ER
46 Q
47NEXT(XMH,XMHDR,XMDATA) ;
48 N I
49 S XMDATA=$$SCRUB(XMDATA) Q:XMDATA=""
50 I XMHDR(XMH)="" S XMHDR(XMH)=XMDATA Q
51 I $L(XMHDR(XMH))+$L(XMDATA)<255 S XMHDR(XMH)=XMHDR(XMH)_" "_XMDATA Q
52 S I=$O(^XMHDR(XMH,":"),-1)+1
53 I $G(XMHDR(XMH,I))'="",$L(XMHDR(XMH,I))+$L(XMDATA)<255 S XMHDR(XMH,I)=$G(XMHDR(XMH,I))_" "_XMDATA Q
54 S XMHDR(XMH,I+1)=XMDATA
55 Q
56HDRPROC ; Process header commands
57 N XMH,XMP,XMRINFO
58 I XMLIN,$O(^XMB(3.9,XMZ,2,XMLIN)) D Q
59 . S XMREJECT=1
60 . S XMSG="500 Synchronization Lost. Msg rejected." X XMSEN
61 . D KILLIT^XMR3A
62 ;I '$D(XMHDR("FROM")) D Q
63 ;. S XMREJECT=1
64 ;. S XMSG="501 Missing FROM Header. Msg rejected." X XMSEN
65 ;. D KILLIT^XMR3A
66 I $$TOOLONG D Q
67 . S XMREJECT=1
68 . S XMSG="551 Too many lines. Msg rejected." X XMSEN
69 . D KILLIT^XMR3A
70 I '$D(XMREMID) S XMREMID=""
71 S (XMH,XMZO,XMFROM,XMENCR,XMSENDER,XMDATE,XMSUBJ)=""
72 F S XMH=$O(XMHDR(XMH)) Q:XMH="" D
73 . S XMP=XMHDR(XMH)
74 . D @XMH
75 I '$O(^XMB(3.9,XMZ,2,.999999)),'$D(XMZFDA(3.9,XMZIENS,.01)) D Q
76 . S XMSG="552 No subject or text. Msg rejected." X XMSEN
77 . D KILLIT^XMR3A
78 . S XMREJECT=1
79 I $G(XMRINFO) D Q
80 . S XMSG="555 Reply to 'Info Only'. Msg rejected." X XMSEN
81 . D KILLIT^XMR3A
82 . S XMREJECT=1
83 ;I $G(XMZFDA(3.9,XMZIENS,9))="" D Q
84 ;. S XMSG="501 No MESSAGE-ID. Msg rejected." X XMSEN
85 ;. D KILLIT^XMR3A
86 ;. S XMREJECT=1
87 ;I '$O(^XMB(3.9,XMZ,2,.999999)) S ^XMB(3.9,XMZ,2,1,0)=" "
88 S ^XMB(3.9,XMZ,2,0)="^^"_XMLIN_U_XMLIN
89 Q
90TOOLONG() ;
91 N XMLIMIT
92 S XMLIMIT=$P($G(^XMB(1,1,"NETWORK-LIMIT")),U,2)
93 Q:'XMLIMIT 0
94 Q:$G(XM2LONG) 1
95 Q:XMLIN'>XMLIMIT 0
96 I $G(XMHDR("TYPE"))["X"!($G(XMHDR("TYPE"))["K") Q 0
97 Q 1
98SCRUB(X) ; Strip ctrl chars and leading/trailing blanks
99 S:X?.E1C.E X=$$CTRL^XMXUTIL1(X)
100 S:$E(X,1)=" "!($E(X,$L(X))=" ") X=$$STRIP^XMXUTIL1(X)
101 Q X
102BASK ; "X-MM-BASKET:" (Delivery Basket)
103 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,21)=XMP
104 Q
105CLOS ; "X-MM-CLOSED:YES"
106 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.95)="y"
107 Q
108DATE ; "DATE:"
109 S XMDATE=XMP
110 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.4)=XMDATE
111 Q
112ENCR ; "ENCRYPT:"
113 S XMENCR=XMP
114 Q:'$D(XMZIENS)
115 S XMZFDA(3.9,XMZIENS,1.8)=$P(XMENCR,U,1) ; scramble hint
116 S XMZFDA(3.9,XMZIENS,1.85)=$P(XMENCR,U,2,999) ; scramble key
117 Q
118EXPI ; "EXPIRY-DATE:" (vaporize date)
119 N XMVAPOR
120 S XMVAPOR=$$CONVERT^XMXUTIL1(XMP,1) Q:XMVAPOR=-1
121 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.6)=XMVAPOR
122 Q
123FROM ; "FROM:"
124 S XMFROM=XMP
125 Q:'$D(XMZIENS)
126 ;I $D(XMHDR("FROM",1)) D CONTINU(.XMFROM,"FROM",.XMHDR)
127 S XMZFDA(3.9,XMZIENS,1)=XMFROM
128 Q
129CONTINU(XMVBL,XMH,XMHDR) ;
130 N I
131 S I=0
132 F S I=$O(XMHDR(XMH,I)) Q:'I S XMVBL=XMVBL_" "_XMHDR(XMH,I)
133 Q
134IMPO ; "IMPORTANCE:HIGH" (Priority)
135 I $$UP^XLFSTR(XMP)'="HIGH"!'$D(XMZIENS) Q
136 S:$G(XMZFDA(3.9,XMZIENS,1.7))'["P" XMZFDA(3.9,XMZIENS,1.7)=$G(XMZFDA(3.9,XMZIENS,1.7))_"P"
137 Q
138INFO ; "X-MM-INFO-ONLY:YES"
139 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.97)="y"
140 Q
141REFE ; "REFERENCES:" (used by some systems, instead of 'in-reply-to')
142 Q
143INRE ; "IN-REPLY-TO:" message at this site
144 N I,XMLOCID,XMREC
145 S XMLOCID=$$REMID(XMP)
146 S XMZO=$$LOCALXMZ^XMR3A(XMLOCID)
147 Q:'XMZO
148 I $P(XMZO,U,3)'="E" S XMZO="" Q
149 S XMZO=+XMZO
150 S XMREC=$G(^XMB(3.9,XMZO,0))
151 I $P(XMREC,U,8) D ; If reply to a reply, get original msg #
152 . S XMZO=$P(XMREC,U,8)
153 . S XMREC=$G(^XMB(3.9,XMZO,0))
154 I XMREC="" S XMZO="" Q ; Original message not found, so make this reply a message.
155 I "^y^Y^"[(U_$P(XMREC,U,12)_U) S XMRINFO=1 Q ; Reply to 'info only' msg
156 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.35)=XMZO ; Point from response to original msg
157 Q
158REMID(X) ;
159 Q:X["<" $TR($P(X,">",1),"<")
160 ; I've seen some like this: "<<...>>"
161 ; I've seen some like this: "<...>; comment here"
162 Q X
163MESS ; "MESSAGE-ID:" at site where message originated
164 S XMREMID=$$REMID(XMP)
165 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,9)=XMREMID
166 Q
167PRIO ; "X-PRIORITY:1" (Priority)
168 I $$UP^XLFSTR(XMP)'=1!'$D(XMZIENS) Q
169 S:$G(XMZFDA(3.9,XMZIENS,1.7))'["P" XMZFDA(3.9,XMZIENS,1.7)=$G(XMZFDA(3.9,XMZIENS,1.7))_"P"
170 Q
171REPL ; "REPLY-TO:"
172 S XMREPLTO=XMP
173 ;I $D(XMHDR("REPL",1)) D CONTINU(.XMREPLTO,"REPL",.XMHDR)
174 Q
175RETU ; "RETURN-RECEIPT-TO:"
176 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.3)="y"
177 Q
178SEND ; "SENDER:" (Surrogate)
179 S XMSENDER=XMP
180 ;I $D(XMHDR("SEND",1)) D CONTINU(.XMSENDER,"SEND",.XMHDR)
181 Q:XMSENDER=$G(XMFROM)
182 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.1)=XMSENDER
183 Q
184SENS ; "SENSITIVITY:PERSONAL" (Confidential)
185 Q:"^PERSONAL^PRIVATE^COMPANY-CONFIDENTIAL^"'[(U_$$UP^XLFSTR(XMP)_U)
186 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.96)="y"
187 Q
188SUBJ ; "SUBJECT:"
189 S XMSUBJ=XMP
190 I XMSUBJ[" " S XMSUBJ=$$MAXBLANK^XMXUTIL1(XMSUBJ)
191 I XMSUBJ["^" S XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
192 S XMSUBJ=$E(XMSUBJ,1,65)
193 Q:XMSUBJ=""!'$D(XMZIENS)
194 I $L(XMSUBJ)<3 S XMSUBJ="..."
195 S XMZFDA(3.9,XMZIENS,.01)=XMSUBJ
196 Q
197TYPE ; "X-MM-TYPE:"
198 S:$D(XMZIENS) XMZFDA(3.9,XMZIENS,1.7)=XMP
199 Q
200SET ; Set data into message file
201 I $G(XMREMID)'="" D CHEKDUP^XMR3A Q:$G(XMREJECT)
202 I $D(XMZFDA) D
203 . 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)
204 . I $L(XMZFDA(3.9,XMZIENS,1))>100 S XMZFDA(3.9,XMZIENS,1)="<"_$$REMADDR^XMXADDR3(XMZFDA(3.9,XMZIENS,1))_">"
205 . D FILE^DIE("","XMZFDA")
206 ;SENDER only RCPT / REMOTE sender drops thru (local>0=pointer)
207 I $G(XMZO) D Q:$O(^TMP("XMY",$J,"")) ; I don't understand this.
208 . D DOTRAN^XMC1(42315,XMZ,XMZO) ;> Putting response |1| into message |2|
209 . D DOTRAN^XMC1(42316,XMZO) ;> Delivering message |1|
210 . D RPOST^XMKP("NR",XMZO,XMZ)
211 D FWD^XMKP(.5,XMZ,.XMINSTR)
212 D CHECK^XMKPL
213 Q
214PARSE(XMZ,XMREMID,XMSUBJ,XMFROM,XMDATE,XMSENDER,XMENCR,XMZO) ; Get data for remotely originated message
215 ; This is used by ^XMRENT & ^XMS3
216 ; XMSUBJ subject
217 ; XMFROM from
218 ; XMDATE date
219 ; XMENCR scramble hint "^" scramble key
220 ; XMREMID message id at site where msg originated (not necessarily at the sending site)
221 ; XMZO original message xmz (to which this msg is a response)
222 N XMP,XMH,XMHDR,XMRINFO,XMZFDA,XMZIENS,XMFIND
223 ; Don't add anything to this list:
224 S XMFIND="^DATE^ENCRYPTED^FROM^IN-REPLY-TO^MESSAGE-ID^SENDER^SUBJECT^"
225 D HDRFIND(XMZ,XMFIND,.XMHDR)
226 S XMH=""
227 F S XMH=$O(XMHDR(XMH)) Q:XMH="" D
228 . S XMP=XMHDR(XMH)
229 . D @XMH
230 Q
231HDRFIND(XMZ,XMFIND,XMHDR) ;
232 N XMH,XMI,XMREC
233 I XMFIND'?1"^".E1"^" D
234 . I $E(XMFIND,1)'=U S XMFIND=U_XMFIND
235 . I $E(XMFIND,$L(XMFIND))'=U S XMFIND=XMFIND_U
236 S XMI=0
237 F S XMI=$O(^XMB(3.9,XMZ,2,XMI)) Q:XMI'<1!'XMI S XMREC=^(XMI,0) Q:XMREC="" D
238 . I $E(XMREC,1)=" "!($E(XMREC,1)=$C(9)) Q:XMH="" D NEXT(XMH,.XMHDR,XMREC) Q
239 . S XMH=$$UP^XLFSTR($P(XMREC,":"))
240 . I XMFIND'[(U_XMH_U) S XMH="" Q
241 . 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
242 . 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
243 . I "^X-PRIORITY^"[(U_XMH_U) S XMH=$E($P(XMH,"-",2),1,4),XMHDR(XMH)=$$SCRUB($P(XMREC,":",2,99)) Q
244 . 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
245 . S XMH=""
246 Q
Note: See TracBrowser for help on using the repository browser.