source: ccr/trunk/p/C0CMAIL.m@ 1225

Last change on this file since 1225 was 1205, checked in by George Lilly, 13 years ago

version for certification

File size: 11.7 KB
Line 
1C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
2V ;;0.1;C0C;nopatch;noreleasedate
3 ;Copyright 2011 Chris Richardson, Richardson Computer Research
4 ; Modified 3110516@1818
5 ; rcr@rcresearch.us
6 ; Licensed under the terms of the GNU
7 ;General Public License See attached copy of the License.
8 ;
9 ;This program is free software; you can redistribute it and/or modify
10 ;it under the terms of the GNU General Public License as published by
11 ;the Free Software Foundation; either version 2 of the License, or
12 ;(at your option) any later version.
13 ;
14 ;This program is distributed in the hope that it will be useful,
15 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;GNU General Public License for more details.
18 ;
19 ;You should have received a copy of the GNU General Public License along
20 ;with this program; if not, write to the Free Software Foundation, Inc.,
21 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 ;
23 ; ------------------
24 ;Entry Points
25 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
26 ; Input:
27 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
28 ; or "*" for all boxes, default is "IN" if missing]"
29 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
30 ; "*" for All or 9,999 maximum
31 ; MALL?1.n = that number of the n most recent
32 ; Internally:
33 ; BNAM = Box Name
34 ; Output:
35 ; C0CDATA
36 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket
37 ; (BNAM,"MSG",C0CIEN,"FROM")=Name
38 ; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
39 ; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
40 ; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
41 ; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
42 ; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
43 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
44 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
45 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
46 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
47 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
48 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
49 ;
50 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
51 ; Input;
52 ; D0 - The IEN for the message in file 3.9, MESSAGE global
53 ; Output
54 ; OUTBF - The array of your choice to save the expanded and decoded message.
55 ;
56GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
57 K:'$G(C0CDATA("KEEP")) C0CDATA
58 N U
59 S U="^"
60 D:$G(C0CINPUT)
61 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
62 . S INPUT=C0CINPUT
63 . S DUZ=+INPUT
64 . D:$D(^XMB(3.7,DUZ,0))#2
65 . . S MBLST=$P(INPUT,";",2)
66 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
67 . . S:MALL["*" MALL=99999
68 . . ; Only one of these can be correct
69 . . D
70 . . . ; If nul, make it "IN" only
71 . . . I MBLST="" D QUIT
72 . . . . S MBLST("IN")=0,I=0
73 . . . . D GATHER(DUZ,"IN",.LST)
74 . . . .QUIT
75 . . . ;
76 . . . ; If "*", Get all Mailboxes and look for New Messages
77 . . . I MBLST["*" D QUIT
78 . . . . N NAM,NUM
79 . . . . S NUM=0
80 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D
81 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
82 . . . . . D GATHER(DUZ,NAM,.LST)
83 . . . . .QUIT
84 . . . .QUIT
85 . . . ;
86 . . . ; If comma separated, look for mailboxes with new messages
87 . . . I $L(MBLST,",")>1 D QUIT
88 . . . . S NAM=""
89 . . . . N T,V
90 . . . . F T=1:1:$L(MBLST,",") S V=$P(MBLST,",",T) I $L(V) D
91 . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
92 . . . . . S:NAM="" NAM=V
93 . . . . . D GATHER(DUZ,NAM,.LST)
94 . . . . .QUIT
95 . . . .QUIT
96 . . . ;
97 . . . ; If only 1 mailbox named, go get it
98 . . . I $L(MBLST) D GATHER(DUZ,MBLST,.LST) QUIT
99 . . .QUIT
100 . . MERGE C0CDATA=LST
101 . .QUIT
102 .QUIT
103 QUIT
104 ; ===================
105GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
106 N I,J,K,L
107 S (I,K)=0
108 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
109 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D
110 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
111 . D ; :L
112 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails
113 . . S LST(NAM,"MSG",I)=L
114 . . D GETTYP(I)
115 . .QUIT
116 .QUIT
117 S LST(NAM,"NUMBER")=K
118 QUIT
119 ; ===================
120 ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
121 ; The products of these emails are scanned to identify
122 ; the number of documents stored in the MIME package.
123 ; The protocol runs like this;
124 ; Line 1 is the --separator
125 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
126 ; Line n+2 thru t-1 where t does NOT have "Content-"
127 ; Line t is Next Section Terminator, or Message Terminator, --separator
128 ; Line t+1 should not exist in the data set if Message Terminator
129 ; CON = "Content-"
130 ; FLG = "--"
131 ; SEP = FLG+7 or more characters ; Separator
132 ; END = SEP+FLG
133 ; SGC = Segment Count
134 ; Note: separator is a string of specific characters of
135 ; indeterminate length
136 ; LST() the transfer array
137 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
138 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
139 ;
140GETTYP(D0) ; Look for the goodies in the Mail
141 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
142 S CON="Content-"
143 S FLG="--"
144 S SEP="" ; Start SEP as null, so we can use this to help identify the type
145 S (BCN,CNT,D1,END,SGC)=0
146 S XX=$G(^XMB(3.9,D0,0))
147 S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
148 S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
149 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
150 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
151 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
152 ; Get the folks the email is sent to.
153 S D1=0
154 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D
155 . N T
156 . S T=+$G(^XMB(3.9,D0,1,D1,0))
157 . S:T T=$P($G(^VA(200,+T,0)),"^")
158 . S LST("TO",D1)=T
159 . S T=$G(^XMB(3.9,D0,6,D1,0))
160 . S:T T=$P($G(^VA(200,+T,0)),"^")
161 . S:T="" T="<Unknown>"
162 . S LST("TO NAME",D1)=T
163 .QUIT
164 ; Preload first Segment (0) with beginning on Line 1
165 ; if not a 64bit
166 S LST(NAM,"MSG",D0,"SEG",0)=1
167 S D1=.9999,SEP="--"
168 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
169 . ; Clear any control characters (cr/lf/ff) off
170 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
171 . ; Enter once to set the SEP to capture the separator
172 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q
173 . . S SEP=X,END=X_FLG
174 . . S (CNT,SGC)=1,BCN=0
175 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
176 . .QUIT
177 . ;
178 . ; A new separator is set, process original
179 . I X=SEP D QUIT
180 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN
181 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
182 . . S SGC=SGC+1,BCN=0
183 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
184 . .QUIT
185 . ;
186 . S BCN=BCN+$L(X)
187 . I X[CON D Q
188 . . S J=$P($P(X,";"),CON,2)
189 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
190 . .QUIT
191 . ;
192 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
193 .QUIT
194 QUIT
195 ; ===================
196NAME(NM) ; Return the name of the Sender
197 N NAME
198 S NAME="<Unknown Sender>"
199 D
200 . ; Look first for a value to use with the NEW PERSON file
201 . ;
202 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
203 . ;
204 . I $L(NM) S NAME=NM Q
205 . ;
206 . ; Else, pull the data from the message and display the foreign source
207 . ; of the message.
208 . N T
209 . S VAL=$G(^XMB(3.9,D0,.7))
210 . S:VAL T=$P(^VA(200,VAL,0),U)
211 . I $L($G(T)) S NAME=T Q
212 . ;
213 .QUIT
214 QUIT NAME
215 ; ===================
216TIME(Y) ; The time and date of the sending
217 X ^DD("DD")
218 QUIT Y
219 ; ===================
220 ; Segments in Message need to be identified and decoded properly
221 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message
222 ; ARRAY will have the details of this one call
223 ;
224 ; Inputs;
225 ; C0CINPUT - The IEN of the message to expand
226 ; Outputs;
227 ; C0CDATA - Carrier for the returned structure of the Message
228 ; C0CDATA(D0,"SEG")=number of SEGMENTS
229 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details
230 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
231 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
232 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
233 ;
234DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
235 N LST,D0,D1,U
236 S U="^"
237 S D0=+$G(C0CINPUT)
238 I D0 D QUIT
239 . D GETTYP2(D0)
240 . I $D(LST) M C0CDATA(D0)=LST
241 .QUIT
242 QUIT
243 ; ===================
244 ; End note if needed
245 ; MSK - Set of characters that do not exist in 64 bit encoding
246GETTYP2(D0) ; Try to get the types and MSK for the
247 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
248 S CON="Content-",U="^"
249 S FLG="--"
250 S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
251 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type
252 S (BCN,CNT,D1,END,SGC)=0
253 S XX=$G(^XMB(3.9,D0,0))
254 ; S K=$P(^XMB(3.9,D0,2,0),U,3)
255 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
256 S LST("CREATED")=$$TIME($P(XX,U,3))
257 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
258 S LST("FROM")=$$NAME(XXNM)
259 ; Get the folks the email is sent to.
260 S D1=0
261 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""
262 . N I,T
263 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
264 . S:T T=$P($G(^VA(200,T,0)),"^")
265 . S LST("TO",+D1)=T
266 . S T=$G(^XMB(3.9,D0,6,+D1,0))
267 . S:T="" T=$P($G(^VA(200,+T,0)),"^")
268 . S:T="" T="<Unknown>"
269 . S LST("TO NAME",D1)=T
270 .QUIT
271 ; Get the Header for the message
272 S D1=0
273 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D
274 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
275 .QUIT
276 ; Start walking the different sections
277 S D1=.99999,SEP="--"
278 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
279 . ; Clear any control characters (cr/lf/ff) off
280 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
281 . ; Enter once to set the SEP to capture the separator
282 . I (SEP="--")&($E(X,1,2)=FLG)&($L(X,FLG)=2) D Q
283 . . S SEP=X,END=X_FLG
284 . . S (CNT,SGC)=1,BCN=0
285 . . S LST("SEG",SGC)=D1
286 . .QUIT
287 . ;
288 . ; A new SEGMENT separator is set, process original
289 . I X=SEP D QUIT
290 . . ; Save Current Values
291 . . S LST("SEG",SGC,"SIZE")=BCN
292 . . ; Close this Segment and prepare to start a New Segment
293 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
294 . . ; Put the result in LST("SEG",SGC,"XML")
295 . . I $L(BF) D
296 . . . S ZN=1
297 . . . N I,T,TBF
298 . . . S TBF=BF
299 . . . F I=1:1:($L(TBF,"=")) D
300 . . . . S BF=$P(TBF,"=",I)_"="
301 . . . . I BF'="=" D DECODER
302 . . . .QUIT
303 . . . S BF=""
304 . . .QUIT
305 . . S SGC=SGC+1,BCN=0
306 . . ; Incriment SGC to start a new Segment
307 . . S LST("SEG",SGC)=D1
308 . .QUIT
309 . ;
310 . ; Accumulate the 64 bit encoding
311 . I X=$TR(X,MSK)&$L(X) D Q
312 . . S BF=BF_X
313 . . S BCN=BCN+$L(X)
314 . .QUIT
315 . ;
316 . ; Ending Condition, close out the Segment
317 . I X=END D QUIT
318 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
319 . . I $L(BF) S ZN=1 D DECODER S BF="" Q
320 . .QUIT
321 . ;
322 . S BCN=BCN+$L(X)
323 . ; Split out the Content Info
324 . I X[CON D Q
325 . . S J=$P(X,CON,2)
326 . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
327 . .QUIT
328 . ;
329 . ; Everything else is Text
330 . S LST("SEG",SGC,"TXT",D1)=X
331 .QUIT
332 QUIT
333 ; ===================
334 ; Break down the Buffer Array so it can be saved.
335 ; BF is passed in.
336DECODER ;
337 N RCNT,TBF,ZBF,ZI,ZJ,ZK,ZSIZE
338 S ZBF=BF
339 ; Full Buffer, BF, now check for Encryption and Unpack
340 F RCNT=1:1:$L(ZBF,"=") D
341 . N BF
342 . S BF=$P(ZBF,"=",RCNT)
343 . ; Unpacking the 64 bit encoding
344 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
345 . D:$L(TBF)
346 . . N XBF
347 . . S BF=BF_"="
348 . . D NORMAL(.XBF,.TBF)
349 . . M LST("SEG",SGC,"XML",RCNT)=XBF
350 . .QUIT
351 .QUIT
352 QUIT
353 ; ===================
354 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT
355 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT
356 ; >D NORMAL^C0CMAIL(.OUT,BF)
357NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
358 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
359 ;
360 N ZN,OUTBF
361 S ZN=1
362 S OUTBF(ZN)=$P(INXML,"><",ZN)_">"
363 F ZN=ZN+1:1 S OUTBF(ZN)="<"_$P(INXML,"><",ZN) Q:$P(INXML,"><",ZN+1)="" D ;
364 . S OUTBF(ZN)=OUTBF(ZN)_">"
365 .QUIT
366 M OUTXML=OUTBF
367 QUIT
368 ; ===================
369 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv
370 ; End note if needed
371 QUIT
372 ; ===================
Note: See TracBrowser for help on using the repository browser.