OpenACS

hectorr
committed
MAIN:hectorr:20200731123637
on 31 Jul 20
Whitespace changes
openacs-4/.../tcl/acs-mail-procs.tcl (+288 -288)
202 202         # Easy as pie.
203 203         # Let's get the data.
204 204
205 205         # vinodk: first get the latest revision
206 206         set revision_id [db_exec_plsql get_latest_revision "
207 207           begin
208 208             return content_item__get_latest_revision ( :content_item_id );
209 209           end;"
210 210         ]
211 211
212 212         set storage_type [db_string get_storage_type "
213 213             select storage_type from cr_items
214 214             where item_id = :content_item_id
215 215         "]
216 216
217 217         if [db_0or1row acs_mail_body_to_mime_get_content_simple {
218 218             select content, mime_type as v_content_type
219 219             from cr_revisions
220 220             where revision_id = :revision_id
221 221         }] {
222                           if [string equal $storage_type text] {
  222             if { $storage_type eq "text" } {
223 223                 ns_log Debug "acs-mail: encode: one part hit $content_item_id"
224 224                 # vinodk: no need for this, since we're checking
225 225                 #         storage_type
226 226                 #
227 227                 # We win!  Hopefully.  Check if there are 8bit characters/data.
228 228                 # HT NL CR SP-~  The full range of ASCII with spaces but no
229 229                 # control characters.
230 230                 #if ![regexp "\[^\u0009\u000A\u000D\u0020-\u007E\]" $content] {
231 231                 #   ns_log Debug "acs-mail: encode: good code $content_item_id"
232 232                 #   # We're still okay.  Use it!
233 233                     return [list $v_content_type $content]
234 234                 #}
235 235                 #ns_log "Notice" "acs-mail: encode: bad code $content_item_id"
236 236             } else {
237 237                 # this content is in the file system or a blob
238 238                 ns_log Debug "acs-mail: encode: binary content $content_item_id"
239 239
240                                   if  [string equal $storage_type file] {
  240                 if { $storage_type eq "file" } {
241 241                     ns_log Debug "acs-mail: encode: file $content_item_id"
242 242                     set encoded_content [acs_mail_uuencode_file [cr_fs_path]$content]
243 243                 } else {
244 244                     ns_log Debug "acs-mail: encode: lob $content_item_id"
245 245                     # Blob. Now we need to decide if this is binary
246 246                     # so we can uuencode it if necessary.
247 247                     # We'll use the mime type to decide
248 248
249 249                     if { [string first "text" $v_content_type] == 0 } {
250 250                         ns_log Debug "acs-mail: encode: plain content"
251 251                         set encoded_content "$content"
252 252                     } else {
253 253                         # binary content - copy the blob to temp file
254 254                         # that we will then uuencode
255 255                         set file [ns_tmpnam]
256 256                         db_blob_get_file copy_blob_to_file "
257 257                             select r.content, i.storage_type
258 258                             from cr_revisions r, cr_items i
259 259                             where r.revision_id = $revision_id and
260 260                                   r.item_id = i.item_id " -file $file
 
263 263                     }
264 264                 }
265 265
266 266                 return [list $v_content_type $encoded_content]
267 267             }
268 268         }
269 269     } else {
270 270         # Harder.  Oops.
271 271         ns_log Debug "acs-mail: encode: multipart $content_item_id"
272 272         set boundary "=-=-="
273 273         set contents {}
274 274         # Get the component pieces
275 275         set multipart_list [db_list_of_lists acs_mail_body_to_mime_get_contents {
276 276             select mime_filename, mime_disposition, content_item_id as ci_id
277 277             from acs_mail_multipart_parts
278 278             where multipart_id = :content_item_id
279 279             order by sequence_number
280 280         }
281 281         ]
282 282
283                   if ![empty_string_p $multipart_list] {
  283         if { $multipart_list ne "" } {
284 284             foreach multipart_item $multipart_list {
285 285                 set mime_filename [lindex $multipart_item 0]
286 286                 set mime_disposition [lindex $multipart_item 1]
287 287                 set ci_id [lindex $multipart_item 2]
288 288
289                                   if {[string equal "" $mime_disposition]} {
290                                           if {![string equal "" $mime_filename]} {
  289                 if { $mime_disposition eq "" } {
  290                     if { $mime_filename ne "" } {
291 291                         set mime_disposition "attachment; filename=$mime_filename"
292 292                     } else {
293 293                         set mime_disposition "inline"
294 294                     }
295 295                 } else {
296                                           if {![string equal "" $mime_filename]} {
  296                     if { $mime_filename ne "" } {
297 297                         set mime_disposition \
298 298                                 "$mime_disposition; filename=$mime_filename"
299 299                     }
300 300                 }
301 301                 set content [acs_mail_encode_content $ci_id]
302 302                 while {[regexp -- "--$boundary--" $content]} {
303 303                     set boundary "=$boundary"
304 304                 }
305 305                 lappend contents [list $mime_disposition $content]
306 306             }
307 307         } else {
308 308             # Defaults
309 309             return {
310 310                 "text/plain; charset=us-ascii"
311 311                 "An OpenACS object was unable to be encoded here.\n"
312 312             }
313 313         }
314 314
315 315         set content_type \
316 316                 "multipart/[acs_mail_multipart_type $content_item_id]; boundary=\"$boundary\""
 
337 337     # Defaults
338 338     return {
339 339         "text/plain; charset=us-ascii"
340 340         "An OpenACS object was unable to be encoded here.\n"
341 341     }
342 342 }
343 343
344 344 ad_proc -private acs_mail_body_to_output_format {
345 345     {-body_id ""}
346 346     {-link_id ""}
347 347 } {
348 348     This will return the given mail body (or the mail body associated with the
349 349     given link) as a properly MIME formatted message.
350 350
351 351     Actually, the result will be in the form:
352 352
353 353     [list $to $from $subject $body $extraheaders]
354 354
355 355     so the info can easily be handed to ns_sendmail (for now.)
356 356 } {
357       if [string equal $body_id ""] {
  357     if { $body_id eq "" } {
358 358         db_1row acs_mail_body_to_mime_get_body {
359 359             select body_id from acs_mail_links where mail_link_id = :link_id
360 360         }
361 361     }
362 362     db_1row acs_mail_body_to_mime_data {
363 363         select header_message_id, header_reply_to, header_subject,
364 364                header_from, header_to, content_item_id
365 365             from acs_mail_bodies
366 366             where body_id = :body_id
367 367     }
368 368     set headers [ns_set new]
369 369     ns_set put $headers "Message-Id" "<$header_message_id>"
370 370     # taking these out because they are redundant and
371 371     # could conflict with the values in acs_mail_queue_outgoing
372 372 #    if ![string equal $header_to ""] {
373 373 #        ns_set put $headers "To" $header_to
374 374 #    }
375 375 #    if ![string equal $header_from ""] {
376 376 #        ns_set put $headers "From" $header_from
377 377 #    }
378       if ![string equal $header_reply_to ""] {
  378     if { $header_reply_to ne "" } {
379 379         ns_set put $headers "In-Reply-To" $header_reply_to
380 380     }
381 381     ns_set put $headers "MIME-Version" "1.0"
382 382     set contents [acs_mail_encode_content $content_item_id]
383 383     set content_type [lindex $contents 0]
384 384     set content [lindex $contents 1]
385 385     ns_set put $headers "Content-Type" "$content_type"
386 386     ns_set put $headers "Content-Encoding" "7bit"
387 387
388 388     db_foreach acs_mail_body_to_mime_headers {
389 389         select header_name, header_content from acs_mail_body_headers
390 390             where body_id = :body_id
391 391     } {
392 392         ns_set put $headers $header_name $header_content
393 393     }
394 394
395 395     return [list $header_to $header_from $header_subject $content $headers]
396 396 }
397 397
398 398 ad_proc -private acs_mail_process_queue {
 
536 536     return $body_id
537 537 }
538 538
539 539 ad_proc -public acs_mail_body_p {
540 540     {object_id}
541 541 } {
542 542     Returns 1 if the argument is an ID for a valid acs_mail_body object.
543 543 } {
544 544     return [string equal "t" [db_exec_plsql acs_mail_body_p {
545 545         begin
546 546             :1 := acs_mail_body.body_p (:object_id);
547 547         end;
548 548     }]]
549 549 }
550 550
551 551 ad_page_contract_filter acs_mail_body_id { name value } {
552 552     Checks whether the value (assumed to be an integer) is the id
553 553     of an already-existing acs_mail_body
554 554 } {
555 555     # empty is okay (handled by notnull)
556       if [empty_string_p $value] {
  556     if { $value eq "" } {
557 557         return 1
558 558     }
559 559     if ![acs_mail_body_p $value] {
560 560         ad_complain "$name does not refer to a valid OpenACS Mail body"
561 561         return 0
562 562     }
563 563     return 1
564 564 }
565 565
566 566 ad_proc -public acs_mail_body_clone {
567 567     {-old_body_id:required}
568 568     {-body_id ""}
569 569     {-creation_user ""}
570 570     {-creation_ip ""}
571 571 } {
572 572     Clone a mail body.  This is a very appropriate thing to do if you're
573 573     going to make changes.  If you want changes to be shared between
574 574     systems that share the message, change in place.  If you don't want
575 575     them to be shared, clone first.
576 576 } {
 
648 648
649 649 ad_proc -public acs_mail_multipart_p {
650 650     {object_id}
651 651 } {
652 652     Returns 1 if the argument is an ID for a valid acs_mail_multipart object.
653 653     Useful for determining whether a body's content is a multipart or a single
654 654     content object.
655 655 } {
656 656     return [string equal "t" [db_exec_plsql acs_mail_multipart_p {
657 657         begin
658 658             :1 := acs_mail_multipart.multipart_p (:object_id);
659 659         end;
660 660     }]]
661 661 }
662 662
663 663 ad_page_contract_filter acs_mail_multipart_id { name value } {
664 664     Checks whether the value (assumed to be an integer) is the id
665 665     of an already-existing acs_mail_multipart
666 666 } {
667 667     # empty is okay (handled by notnull)
668       if [empty_string_p $value] {
  668     if { $value eq "" } {
669 669         return 1
670 670     }
671 671     if ![acs_mail_multipart_p $value] {
672 672       ad_complain "$name does not refer to a valid OpenACS Mail multipart"
673 673       return 0
674 674     }
675 675     return 1
676 676 }
677 677
678 678 ad_proc -public acs_mail_multipart_add_content {
679 679     {-multipart_id:required}
680 680     {-content_item_id:required}
681 681 } {
682 682     Add a new item to a given multipart object at the end.
683 683 } {
684 684     return [db_exec_plsql acs_mail_multipart_add_content {
685 685         begin
686 686             :1 = acs_mail_multipart.add_content (
687 687                 multipart_id => :multipart_id,
688 688                 content_item_id => :content_item_id
 
750 750     }]
751 751 }
752 752
753 753 ad_proc -public acs_mail_link_p {
754 754     {object_id}
755 755 } {
756 756     Returns 1 if the argument is an ID for a valid acs_mail_link object.
757 757 } {
758 758     return [string equal "t" [db_exec_plsql acs_mail_link_p {
759 759         begin
760 760             :1 := acs_mail_link.link_p (:object_id);
761 761         end;
762 762     }]]
763 763 }
764 764
765 765 ad_page_contract_filter acs_mail_link_id { name value } {
766 766     Checks whether the value (assumed to be an integer) is the id
767 767     of an already-existing acs_mail_link
768 768 } {
769 769     # empty is okay (handled by notnull)
770       if [empty_string_p $value] {
  770     if { $value eq "" } {
771 771         return 1
772 772     }
773 773     if ![acs_mail_link_p $value] {
774 774       ad_complain "$name does not refer to a valid OpenACS Mail link"
775 775       return 0
776 776     }
777 777     return 1
778 778 }
779 779