Index: openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl,v
diff -u -r1.4 -r1.4.4.1
--- openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl 7 Nov 2003 17:43:33 -0000 1.4
+++ openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl 6 Jul 2004 15:47:40 -0000 1.4.4.1
@@ -25,135 +25,117 @@
to be unable to handle utf-8 encoding). A future version of this proc
should probably support an alternative charset argument or switch.
} {
-
+ ## JCD: we moved these into -procs.tcl files so they get
+ ## sourced when we bootstrap.
# this is always called from a scheduled proc
- set r_dir [acs_root_dir]/packages/acs-tcl/tcl
- source $r_dir/base64.tcl
- source $r_dir/md5.tcl
- source $r_dir/mime.tcl
+ # set r_dir [acs_root_dir]/packages/acs-tcl/tcl
+ #source $r_dir/base64.tcl
+ #source $r_dir/md5.tcl
+ #source $r_dir/mime.tcl
package require mime
- # since mime tries to treat =xx as a hex ascii code, replace any
- # equals signs with "=3d" (mime encoding of equals sign)
- regsub -all "=" $text_body "=3d" text_body
- regsub -all "=" $html_body "=3d" html_body_for_non_base64
-
# convert text to charset
set encoding [ns_encodingforcharset $charset]
if {[lsearch [encoding names] $encoding] != -1} {
set html_body [encoding convertto $encoding $html_body]
set text_body [encoding convertto $encoding $text_body]
- } else {
+ } else {
ns_log error "ad_html_sendmail: unknown charset passed in ($charset)"
- }
+ }
# build body
- set base64_html_part [mime::initialize -canonical text/html \
- -param [list charset $charset] \
- -encoding base64 \
- -string $html_body]
+
+ ## JCD: I fail to see why you would want both a base64 and a quoted-printable
+ ## version of html part of this email. I am removing the base64 version.
+ ## set base64_html_part [mime::initialize -canonical text/html -param [list charset $charset] -encoding base64 -string $html_body]
set html_part [mime::initialize -canonical text/html \
- -param [list charset $charset] \
- -encoding quoted-printable \
- -string $html_body_for_non_base64]
+ -param [list charset $charset] \
+ -encoding quoted-printable \
+ -string $html_body]
set text_part [mime::initialize -canonical text/plain \
- -param [list charset $charset] \
- -encoding quoted-printable \
- -string $text_body]
- #It works better without 'charset'!
- # set multi_part [mime::initialize -canonical multipart/alternative \
- # -param [list charset $charset] \
- # -parts [list $text_part $html_part]]
- set multi_part [mime::initialize -canonical multipart/alternative \
- -parts [list $text_part $base64_html_part $html_part]]
+ -param [list charset $charset] \
+ -encoding quoted-printable \
+ -string $text_body]
- # this gives us a complete mime message, minus the headers because
- # we don't pass any in. This code is designed to send a fully-formed
- # message out through an SMTP socket, but we're not doing that so we
- # have to hijack the process a bit.
- set mime_body [mime::buildmessage $multi_part]
+ set multi_part [mime::initialize \
+ -canonical multipart/alternative \
+ -parts [list $text_part $html_part]]
- # the first three lines of the message are special; we need to grab
- # the info, add it to the message headers, and discard the lines
- set lines [split $mime_body \n]
- set message_data [ns_set new]
+ # this gives us a complete mime message, minus the headers because
+ # we don't pass any in. This code is designed to send a fully-formed
+ # message out through an SMTP socket, but we're not doing that so we
+ # have to hijack the process a bit.
+ set mime_body [mime::buildmessage $multi_part]
- # get mime version
- regexp {MIME-Version: (.*)} [lindex $lines 0] junk mime_version
- ns_set put $message_data MIME-Version $mime_version
- # the content id
- regexp {Content-ID: (.*)} [lindex $lines 1] junk content_id
- ns_set put $message_data Content-ID $content_id
- # and the content type and boundary
- regexp {Content-Type: (.*)} [lindex $lines 2] junk content_type
- set content_type "$content_type\n[lindex $lines 3]"
- ns_set put $message_data Content-Type $content_type
+ # the first three lines of the message are special; we need to grab
+ # the info, add it to the message headers, and discard the lines
+ set lines [split $mime_body \n]
+ set message_data [ns_set new]
- # the rest of the lines form the message body. We strip off the last
- # line, which is the last boundary, because ns_sendmail seems to be
- # adding another one on for us.
- ns_set put $message_data body [join [lrange $lines 4 [expr [llength $lines] - 3]] \n]
+ # get mime version
+ regexp {MIME-Version: (.*)} [lindex $lines 0] junk mime_version
+ ns_set put $message_data MIME-Version $mime_version
+ # the content id
+ regexp {Content-ID: (.*)} [lindex $lines 1] junk content_id
+ ns_set put $message_data Content-ID $content_id
+ # and the content type and boundary
+ regexp {Content-Type: (.*)} [lindex $lines 2] junk content_type
+ set content_type "$content_type\n[lindex $lines 3]"
+ ns_set put $message_data Content-Type $content_type
- return $message_data
+ # the rest of the lines form the message body. We strip off the last
+ # line, which is the last boundary, because ns_sendmail seems to be
+ # adding another one on for us.
+
+ ## JCD: not anymore. maybe an aolserver 3.3 bug? removing the clipping.
+ ns_set put $message_data body [join [lrange $lines 4 end] \n]
+
+ return $message_data
}
ad_proc parse_incoming_email {
- message
+ message
} {
- Takes an incoming message and splits it into parts. The main goal
- of this proc is to return something that can be stuffed into the
- database somewhere, such as a forum message. Since we aggressively
- filter HTML, the HTML tags are stripped out of the returned content.
+ Takes an incoming message and splits it into parts. The main goal
+ of this proc is to return something that can be stuffed into the
+ database somewhere, such as a forum message. Since we aggressively
+ filter HTML, the HTML tags are stripped out of the returned content.
- The message may have only plain text, plain text and HTML, or plain
- text and something else (Apple Mail uses text/enhanced, for example).
- To make our lives simpler we support only text/html as a special case;
- in all other cases the plain text is returned.
+ The message may have only plain text, plain text and HTML, or plain
+ text and something else (Apple Mail uses text/enhanced, for example).
+ To make our lives simpler we support only text/html as a special case;
+ in all other cases the plain text is returned.
} {
- # look for the files we need. If they aren't there, we can't do anything
- # and will just return the message as-is (cringe)
- set source_dir [acs_root_dir]/packages/acs-tcl/tcl
- if { ![file exists $source_dir/base64-procs.tcl] ||
- ![file exists $source_dir/md5-procs.tcl] ||
- ![file exists $source_dir/mime-procs.tcl] } {
- return $message
- }
+ set mime [mime::initialize -string $message]
+ set content [mime::getproperty $mime content]
- source $source_dir/base64-procs.tcl
- source $source_dir/md5-procs.tcl
- source $source_dir/mime-procs.tcl
- package require mime
+ if { [string first "multipart" $content] != -1 } {
+ set parts [mime::getproperty $mime parts]
+ } else {
+ set parts [list $mime]
+ }
- set mime [mime::initialize -string $message]
- set content [mime::getproperty $mime content]
+ foreach part $parts {
+ switch [mime::getproperty $part content] {
+ "text/plain" {
+ set plain [mime::getbody $part]
+ }
+ "text/html" {
+ set html [mime::getbody $part]
+ }
+ }
+ }
- if { [string first "multipart" $content] != -1 } {
- set parts [mime::getproperty $mime parts]
- } else {
- set parts [list $mime]
- }
+ if { [info exists html] } {
+ set body [ad_html_to_text -- $html]
+ } elseif { [info exists plain] } {
+ set body $plain
+ } else {
+ set body $message
+ }
- foreach part $parts {
- switch [mime::getproperty $part content] {
- "text/plain" {
- set plain [mime::getbody $part]
- }
- "text/html" {
- set html [mime::getbody $part]
- }
- }
- }
-
- if { [info exists html] } {
- set body [ad_html_to_text -- $html]
- } elseif { [info exists plain] } {
- set body $plain
- } else {
- set body $message
- }
-
- mime::finalize $mime -subordinates all
- return $body
+ mime::finalize $mime -subordinates all
+ return $body
}