Index: openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/Attic/complex-send-procs.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 29 Nov 2007 23:18:57 -0000 1.17
+++ openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 5 Dec 2007 08:26:21 -0000 1.18
@@ -154,9 +154,6 @@
{-to_party_ids ""}
{-cc_party_ids ""}
{-bcc_party_ids ""}
- {-to_group_ids ""}
- {-cc_group_ids ""}
- {-bcc_group_ids ""}
{-to_addr ""}
{-cc_addr ""}
{-bcc_addr ""}
@@ -183,18 +180,12 @@
For backward compatibility a switch "single_email_p" is added.
- @param to_party_ids list of party ids to whom we send this email
+ @param to_party_ids list of party ids (including groups) to whom we send this email
- @param cc_party_ids list of party ids to whom we send this email in "CC"
+ @param cc_party_ids list of party ids (including groups) to whom we send this email in "CC"
- @param bcc_party_ids list of party ids to whom we send this email in "BCC"
+ @param bcc_party_ids list of party ids (including groups) to whom we send this email in "BCC"
- @param to_party_ids list of group_ids to whom we send this email
-
- @param cc_party_ids list of group_ids to whom we send this email in "CC"
-
- @param bcc_party_ids list of group_ids to whom we send this email in "BCC"
-
@param to_addr List of e-mail addresses to send this mail to. We will figure out the name if possible.
@param from_addr E-Mail address of the sender. We will try to figure out the name if possible.
@@ -237,37 +228,32 @@
set package_id $mail_package_id
}
- # We check if the parameter
+
+ ###########################################
+ #
+ # Prepare the sender and reply to address
+ #
+ ###########################################
+
+ # We check if we need to use a fixed sender which overwrites
+ # the original sender
set fixed_sender [parameter::get -parameter "FixedSenderEmail" \
-package_id $mail_package_id]
-
if { $fixed_sender ne "" && !$use_sender_p} {
set sender_addr $fixed_sender
} else {
set sender_addr $from_addr
}
- # default values for alternative_part_p
- # TRUE on mime_type text/html
- # FALSE on mime_type text/plain
- # if { $alternative_part_p eq "" } { ...}
- if { $alternative_part_p eq "" } {
- if { $mime_type eq "text/plain" } {
- set alternative_part_p "0"
- } else {
- set alternative_part_p "1"
- }
- }
+ # Get the party_id for the sender
+ set party_id($from_addr) [party::get_by_email -email $from_addr]
# Set the Reply-To
if {$reply_to eq ""} {
set reply_to $sender_addr
}
- # Get the party_id for the sender
- set party_id($from_addr) [party::get_by_email -email $from_addr]
-
# Deal with the sender address. Only change the from string if we find a party_id
# This should take care of anyone parsing in an email which is already formated with <>.
set party_id($sender_addr) [party::get_by_email -email $sender_addr]
@@ -279,9 +265,60 @@
set reply_to_string $sender_addr
}
-
- # decision between normal or multipart/alternative body
+ ##########################
+ #
+ # Prepare the recipients
+ #
+ ##########################
+
+ foreach type [list to cc bcc] {
+ set ${type}_recipient_list [list]
+
+ foreach email [set ${type}_addr] {
+ set party_id($email) [party::get_by_email -email $email]
+ if {$party_id($email) eq ""} {
+ # We could not find a party_id, write the email alone
+
+ set recipient [acs_mail_lite::prepare_recipient -email $email]
+ if {$recipient ne ""} {
+ lappend ${type}_recipient_list $recipient
+ }
+
+ } else {
+ lappend $party_ids $party_id($email)
+ }
+ }
+
+ # Weed out the duplicates and resolve groups
+ set party_ids [party::resolve_members -party_ids $party_ids]
+
+ foreach party_id $party_ids {
+ set recipient [acs_mail_lite::prepare_recipient -party_id $party_id]
+ if {$recipient ne ""} {
+ lappend ${type}_recipient_list $recipient
+ }
+ }
+ }
+
+
+ # This part should probably go to a different procedure....
+
+ ##################
+ # default values for alternative_part_p
+ # TRUE on mime_type text/html
+ # FALSE on mime_type text/plain
+ # if { $alternative_part_p eq "" } { ...}
+ if { $alternative_part_p eq "" } {
+ if { $mime_type eq "text/plain" } {
+ set alternative_part_p "0"
+ } else {
+ set alternative_part_p "1"
+ }
+ }
+
+ # decision between normal or multipart/alternative body
+
# Encode the body with UTF-8 charset
set charset "UTF-8"
set encoding [ns_encodingforcharset $charset]
@@ -327,54 +364,28 @@
# encode all attachments in base64
set tokens [list $message_token]
- set item_ids [list]
- if {[exists_and_not_null file_ids]} {
+ #############
+ # End of block to go in separate proc
+ #############
- set multi_token_type "multipart/mixed"
- # Check if we are dealing with revisions or items.
- foreach file_id $file_ids {
- set item_id [content::revision::item_id -revision_id $file_id]
- if {$item_id eq ""} {
- lappend item_ids $file_id
- } else {
- lappend item_ids $item_id
- }
- }
+ # Prepare the attachments
+ set attachments [acs_mail_lite::encode_attachments -file_ids $file_ids -folder_ids $folder_ids -files $files]
+ set item_ids [lindex $attachments 0]
+ set attachment_tokens [lindex $attachments 1]
+ set tokens [concat $tokens $attachment_tokens]
- db_foreach get_file_info "select r.mime_type,r.title, r.content as filename
- from cr_revisions r, cr_items i
- where r.revision_id = i.latest_revision
- and i.item_id in ([join $item_ids ","])" {
- lappend tokens [mime::initialize -param [list name "[ad_quotehtml $title]"] -header [list "Content-Disposition" "attachment; filename=$title"] -header [list Content-Description $title] -canonical $mime_type -file "[cr_fs_path]$filename"]
- }
- }
+ # We have at least one attachment so change the type to multipart/mixed
+ if {[llenght $attachment_tokens] > 0} {
+ set multi_token_type "multipart/mixed"
+ }
+ #####################
+ #
+ # Compose the e-mail
+ #
+ #####################
- # Append files from the filesystem
- if {$files ne ""} {
- set multi_token_type "multipart/mixed"
- foreach file $files {
- lappend tokens [mime::initialize -param [list name "[ad_quotehtml [lindex $file 0]]"] -canonical [lindex $file 1] -file "[lindex $file 2]"]
- }
- }
-
- # Append folders
- if {[exists_and_not_null folder_ids]} {
-
- foreach folder_id $folder_ids {
- db_foreach get_file_info {select r.revision_id,r.mime_type,r.title, i.item_id, r.content as filename
- from cr_revisions r, cr_items i
- where r.revision_id = i.latest_revision and i.parent_id = :folder_id} {
- lappend tokens [mime::initialize -param [list name "[ad_quotehtml $title]"] -canonical $mime_type -file "[cr_fs_path]$filename"]
- lappend item_ids $item_id
- set multi_token_type "multipart/mixed"
- }
- }
- }
-
-
- #### Now we start with composing the mail message ####
if { $multi_token_type eq "multipart/mixed" } {
set multi_token [mime::initialize -canonical $multi_token_type -parts "$tokens"]
} else {
@@ -397,256 +408,113 @@
set packaged [mime::buildmessage $multi_token]
- # Now the To recipients
- set to_list [list]
- foreach email $to_addr {
- set party_id($email) [party::get_by_email -email $email]
- if {$party_id($email) eq ""} {
- # We could not find a party_id, write the email alone
- lappend to_list $email
- } else {
- # Make sure we are not sending the same e-mail twice to the same person
- if {[lsearch $to_party_ids $party_id($email)] < 0} {
- lappend to_party_ids $party_id($email)
- }
- }
- }
- # Run through the party_ids and check if a group is in there.
- set new_to_party_ids [list]
- foreach to_id $to_party_ids {
- if {[group::group_p -group_id $to_id]} {
- lappend to_group_ids $to_id
- } else {
- if {[lsearch $new_to_party_ids $to_id] < 0} {
- lappend new_to_party_ids $to_id
- }
- }
- }
+ ###################
+ #
+ # Send the e-mail
+ #
+ ###################
- foreach group_id $to_group_ids {
- foreach to_id [group::get_members -group_id $group_id] {
- if {[lsearch $new_to_party_ids $to_id] < 0} {
- lappend new_to_party_ids $to_id
- }
- }
- }
-
- # New to party ids contains now the unique party_ids of members of the groups along with the parties
- set to_party_ids $new_to_party_ids
-
- # Now the Cc recipients
- set cc_list [list]
-
- foreach email $cc_addr {
- set party_id($email) [party::get_by_email -email $email]
- if {$party_id($email) eq ""} {
- # We could not find a party_id, write the email alone
- lappend cc_list $email
- } else {
- # Make sure we are not sending the same e-mail twice to the same person
- if {[lsearch $cc_party_ids $party_id($email)] < 0} {
- lappend cc_party_ids $party_id($email)
- }
- }
- }
-
- # Run through the party_ids and check if a group is in there.
- set new_cc_party_ids [list]
- foreach cc_id $cc_party_ids {
- if {[group::group_p -group_id $cc_id]} {
- lappend cc_group_ids $cc_id
- } else {
- if {[lsearch $new_cc_party_ids $cc_id] < 0} {
- lappend new_cc_party_ids $cc_id
- }
- }
- }
+
+ if {$single_email_p} {
- foreach group_id $cc_group_ids {
- foreach cc_id [group::get_members -group_id $group_id] {
- if {[lsearch $new_cc_party_ids $cc_id] < 0} {
- lappend new_cc_party_ids $cc_id
- }
- }
- }
-
- # New to party ids contains now the unique party_ids of members of the groups along with the parties
- set cc_party_ids $new_cc_party_ids
-
- # Now the Bcc recipients
- set bcc_list [list]
-
- foreach email $bcc_addr {
- set party_id($email) [party::get_by_email -email $email]
- if {$party_id($email) eq ""} {
- # We could not find a party_id, write the email alone
- lappend bcc_list $email
- } else {
- # Make sure we are not sending the same e-mail twice to the same person
- if {[lsearch $bcc_party_ids $party_id($email)] < 0} {
- lappend bcc_party_ids $party_id($email)
- }
- }
- }
-
- # Run through the party_ids and check if a group is in there.
- set new_bcc_party_ids [list]
- foreach bcc_id $bcc_party_ids {
- if {[group::group_p -group_id $bcc_id]} {
- lappend bcc_group_ids $bcc_id
- } else {
- if {[lsearch $new_bcc_party_ids $bcc_id] < 0} {
- lappend new_bcc_party_ids $bcc_id
- }
- }
- }
+ #############################
+ #
+ # One mail to all
+ #
+ #############################
- foreach group_id $bcc_group_ids {
- foreach bcc_id [group::get_members -group_id $group_id] {
- if {[lsearch $new_bcc_party_ids $bcc_id] < 0} {
- lappend new_bcc_party_ids $bcc_id
- }
- }
- }
+ # Resolve the various types into two lists
+ # so we have the emails in one and the
+ # party_ids in the other (needed for the callback)
+
+ foreach type [list to cc bcc] {
+ set addr_list [list]
+ set ${type}_party_ids [list]
+
+ foreach recipient [set ${type}_recipient_list] {
+ lappend ${type}_party_ids [lindex $recipient 0]
+ lappend addr_list [lindex $recipient 1]
+ }
+
+ set ${type}_addr_string [join $addr_list ","]
+ }
+
+ # Send out the E-Mail
+ acs_mail_lite::complex_smtp -multi_token $multi_token \
+ -headers [list [list From "$from_string"] [list Reply-To "$reply_to_string"] \
+ [list To "$to_addr_string ","]"] [list CC "[join $cc_addr_string ","]"] \
+ [list BCC "[join $bcc_addr_string ","]"]]
+
+ #Close all mime tokens
+ mime::finalize $multi_token -subordinates all
+
+ if { !$no_callback_p } {
+ # First join the emails without parties for the callback.
+ callback acs_mail_lite::complex_send \
+ -package_id $package_id \
+ -from_party_id [party::get_by_email -email $sender_addr] \
+ -from_addr $sender_addr \
+ -to_party_ids $to_party_ids \
+ -cc_party_ids $cc_party_ids \
+ -bcc_party_ids $bcc_party_ids \
+ -to_addr $to_addr_string \
+ -cc_addr $cc_addr_string \
+ -bcc_addr $bcc_addr_string \
+ -body $body \
+ -message_id $message_id \
+ -subject $subject \
+ -object_id $object_id \
+ -file_ids $item_ids
+ }
+
+
+ } else {
+
+ ####################################################################
+ #
+ # Individual E-Mails.
+ # All recipients, (regardless who they are) get a separate E-Mail
+ #
+ ####################################################################
+
+ # We send individual e-mails.
+ set recipient_list [concat $to_recipient_list $cc_recipient_list $bcc_recipient_list]
+
+ foreach recipient $recipient_list {
+ set party_id [lindex $recipient 0]
+ set address [lindex $recipient 1]
+ set message_id [mime::uniqueID]
+ acs_mail_lite::complex_smtp -multi_token $multi_token \
+ -headers [list [list From "$from_string"] [list Reply-To "$reply_to_string"] [list To "$address"]]
+ if { !$no_callback_p } {
+ # If we have a party_id record only the
+ # party_id
+ if {$party_id ne ""} {
+ set address ""
+ }
+
+ callback acs_mail_lite::complex_send \
+ -package_id $package_id \
+ -from_party_id [party::get_by_email -email $sender_addr] \
+ -from_addr $from_addr \
+ -to_addr $address \
+ -to_party_ids $party_id \
+ -body $body \
+ -message_id $message_id \
+ -subject $subject \
+ -object_id $object_id \
+ -file_ids $item_ids
+ }
+ }
+
+ #Close all mime tokens
+ mime::finalize $multi_token -subordinates all
+ }
+ }
- # New to party ids contains now the unique party_ids of members of the groups along with the parties
- set bcc_party_ids $new_bcc_party_ids
- # Rollout support (see above for details)
-
- set delivery_mode [ns_config ns/server/[ns_info server]/acs/acs-rollout-support EmailDeliveryMode]
- if {$delivery_mode ne ""
- && $delivery_mode ne "default"
- } {
- set eh [util_list_to_ns_set $extraheaders]
- ns_sendmail $to_addr $sender_addr $subject $packaged $eh $bcc_addr
- #Close all mime tokens
- mime::finalize $multi_token -subordinates all
- } else {
-
- if {$single_email_p} {
-
- #############################
- #
- # One mail to all
- #
- #############################
-
- # First join the emails without parties for the callback.
- set to_addr_string [join $to_list ","]
- set cc_addr_string [join $cc_list ","]
- set bcc_addr_string [join $bcc_list ","]
-
- # Append the entries from the system users to the e-mail
- foreach party $to_party_ids {
- lappend to_list "\"[party::name -party_id $party]\" <[party::email_not_cached -party_id $party]>"
- }
-
- foreach party $cc_party_ids {
- lappend cc_list "\"[party::name -party_id $party]\" <[party::email_not_cached -party_id $party]>"
- }
-
- foreach party $bcc_party_ids {
- lappend bcc_list "\"[party::name -party_id $party]\" <[party::email_not_cached -party_id $party]>"
- }
-
-
- acs_mail_lite::complex_smtp -multi_token $multi_token \
- -headers [list [list From "$from_string"] [list Reply-To "$reply_to_string"] \
- [list To "[join $to_list ","]"] [list CC "[join $cc_list ","]"]]
-
- #Close all mime tokens
- mime::finalize $multi_token -subordinates all
-
- if { !$no_callback_p } {
- callback acs_mail_lite::complex_send \
- -package_id $package_id \
- -from_party_id [party::get_by_email -email $sender_addr] \
- -from_addr $sender_addr \
- -to_party_ids $to_party_ids \
- -cc_party_ids $cc_party_ids \
- -bcc_party_ids $bcc_party_ids \
- -to_addr $to_addr_string \
- -cc_addr $cc_addr_string \
- -bcc_addr $bcc_addr_string \
- -body $body \
- -message_id $message_id \
- -subject $subject \
- -object_id $object_id \
- -file_ids $item_ids
- }
-
-
- } else {
-
- ####################################################################
- #
- # Individual E-Mails.
- # All recipients, (regardless who they are) get a separate E-Mail
- #
- ####################################################################
-
- # We send individual e-mails. First the ones that do not have a party_id
- set recipient_list [concat $to_list $cc_list $bcc_list]
- foreach email $recipient_list {
- set message_id [mime::uniqueID]
-
-
- if {[acs_mail_lite::valid_email_p $email]} {
- acs_mail_lite::complex_smtp -multi_token $multi_token \
- -headers [list [list From "$from_string"] [list Reply-To "$reply_to_string"] [list To "$email"]]
- if { !$no_callback_p } {
- callback acs_mail_lite::complex_send \
- -package_id $package_id \
- -from_party_id $party_id($from_addr) \
- -from_addr $from_addr \
- -to_addr $email \
- -body $body \
- -message_id $message_id \
- -subject $subject \
- -object_id $object_id \
- -file_ids $item_ids
- }
- } else {
- acs_mail_lite::record_bounce -email $email
- }
- }
-
- # And now we send it to all the other users who actually do have a party_id
- set recipient_list [concat $to_party_ids $cc_party_ids $bcc_party_ids]
- foreach party $recipient_list {
- set message_id [mime::uniqueID]
- set email [party::email_not_cached -party_id $party]
- if {[acs_mail_lite::valid_email_p -email $email]} {
- set email "\"[party::name -party_id $party]\" <$email>"
-
- acs_mail_lite::complex_smtp -multi_token $multi_token \
- -headers [list [list From "$from_string"] [list Reply-To "$reply_to_string"] [list To "$email"]]
-
- if { !$no_callback_p } {
- callback acs_mail_lite::complex_send \
- -package_id $package_id \
- -from_party_id $party_id($from_addr) \
- -from_addr $from_addr \
- -to_party_ids $party \
- -body $body \
- -message_id $message_id \
- -subject $subject \
- -object_id $object_id \
- -file_ids $item_ids
- }
- } else {
- acs_mail_lite::record_bounce -user_id $party
- }
- }
- #Close all mime tokens
- mime::finalize $multi_token -subordinates all
- }
- }
- }
-
#---------------------------------------
# 2006/11/17 Created by cognovis/nfl
# nsv_incr description: http://www.panoptic.com/wiki/aolserver/Nsv_incr
@@ -671,12 +539,9 @@
# send the mail
set err [catch {
acs_mail_lite::complex_send_immediately \
- -to_party_ids $to_party_ids \
- -cc_party_ids $cc_party_ids \
- -bcc_party_ids $bcc_party_ids \
- -to_group_ids $to_group_ids \
- -cc_group_ids $cc_group_ids \
- -bcc_group_ids $bcc_group_ids \
+ -to_party_ids [concat $to_party_ids $to_group_ids]\
+ -cc_party_ids [concat $cc_party_ids $cc_group_ids] \
+ -bcc_party_ids [concat $bcc_party_ids $bcc_group_ids] \
-to_addr $to_addr \
-cc_addr $cc_addr \
-bcc_addr $bcc_addr \
@@ -712,11 +577,113 @@
}
}
+ ad_proc -private encode_attachments {
+ {-file_ids ""}
+ {-folder_ids ""}
+ {-files ""}
+ } {
+ This procedure takes files and folders and returns a list of
+ item_ids if possible and the list of tokens
+
+ @param files List of file_title, mime_type, file_path (as in full path to the file) combination of files to be attached
+
+ @param folder_ids ID of the folder who's content will be send along with the e-mail.
+
+ @param file_ids List of file ids (items or revisions) to be send as attachments. This will only work with files stored in the file system.
+
+ @return list of the list of item_ids and tokens
+ } {
+ set item_ids [list]
+ set tokens [list]
+
+ if {[exists_and_not_null file_ids]} {
+
+ # Check if we are dealing with revisions or items.
+ foreach file_id $file_ids {
+ set item_id [content::revision::item_id -revision_id $file_id]
+ if {$item_id eq ""} {
+ lappend item_ids $file_id
+ } else {
+ lappend item_ids $item_id
+ }
+ }
+
+ db_foreach get_file_info "select r.mime_type,r.title, r.content as filename
+ from cr_revisions r, cr_items i
+ where r.revision_id = i.latest_revision
+ and i.item_id in ([join $item_ids ","])" {
+ lappend tokens [mime::initialize -param [list name "[ad_quotehtml $title]"] -header [list "Content-Disposition" "attachment; filename=$title"] -header [list Content-Description $title] -canonical $mime_type -file "[cr_fs_path]$filename"]
+ }
+ }
+
+
+ # Append files from the filesystem
+ if {$files ne ""} {
+ foreach file $files {
+ lappend tokens [mime::initialize -param [list name "[ad_quotehtml [lindex $file 0]]"] -canonical [lindex $file 1] -file "[lindex $file 2]"]
+ }
+ }
+
+ # Append folders
+ if {[exists_and_not_null folder_ids]} {
+
+ foreach folder_id $folder_ids {
+ db_foreach get_file_info {select r.revision_id,r.mime_type,r.title, i.item_id, r.content as filename
+ from cr_revisions r, cr_items i
+ where r.revision_id = i.latest_revision and i.parent_id = :folder_id} {
+ lappend tokens [mime::initialize -param [list name "[ad_quotehtml $title]"] -canonical $mime_type -file "[cr_fs_path]$filename"]
+ lappend item_ids $item_id
+ }
+ }
+ }
+ return [list $item_ids $tokens]
+ }
+
+ ad_proc -private prepare_recipient {
+ {-email ""}
+ {-party_id}
+ } {
+ Returns the formated string for e-mail headers of the recipient
+ along with the party_id. It will try to find out the name
+ and party_id if possible. It also checks if the e-mail is valid
+
+ @param email The email address of the recipient
+ @param party_id The party_id of the recipient
+ @return List of party_id and string for the e-mail inclusion. Empty string is returned if the email is invalid.
+ } {
+ if {$email ne ""} {
+ set party_id [party::get_by_email -email $email]
+ } else {
+ set email [party::email_not_cached -party_id $party_id]
+ }
+
+ if {[acs_mail_lite::valid_email_p $email]} {
+ if {$party_id eq ""} {
+ # We could not find a party_id, write the email alone
+ return [list "" $email]
+ } else {
+ return [list $party_id "\"[party::name -party_id $party_id]\" <$email>"]
+ }
+ } else {
+ acs_mail_lite::record_bounce -email $email
+ return ""
+ }
+ }
+
+ ad_proc -private prepare_recipients {
+ {-emails ""}
+ {-party_ids ""}
+ } {
+ Receive a list of emails and party_ids and return the formated
+ string with the names to be used
+ }
+
+
ad_proc -private complex_smtp {
-multi_token:required
-headers:required
} {
- Send messages via SMTP
+ Send messages via SMTP. Takes care of rollout support
@param multi_token Multi Token generated which is passed directly to smtp::sendmessage
@param headers List of list of header key-value pairs like {{from malte@cognovis.de} {to malte@cognovis.de}}
@@ -746,16 +713,31 @@
set smtppassword [parameter::get -parameter "SMTPPassword" \
-package_id $mail_package_id]
- set cmd_string "smtp::sendmessage $multi_token"
- foreach header $headers {
- append cmd_string " -header {$header}"
- }
- append cmd_string " -servers $smtp -ports $smtpport -username $smtpuser -password $smtppassword"
- ns_log Debug "complex-send cmd_string: $cmd_string"
- eval $cmd_string
+
+ # Rollout support
+ switch $delivery_mode {
+ log {ns_log Notice "Sending E-Mail to headers $headers $multitoken"}
+ redirect {
+ set redirect_address [ns_config ns/server/[ns_info server]/acs/acs-rollout-support EmailRedirectTo]
+ eval "smtp::sendmessage $multitoken -header [list From "$from_string"] -header [list Reply-To "$reply_to_string"] -header [list To "$redirect_address"]]"
+ }
+ filter {
+ # No idea how to do this
+ }
+ default {
+ set cmd_string "smtp::sendmessage $multi_token"
+ foreach header $headers {
+ append cmd_string " -header {$header}"
+ }
+ append cmd_string " -servers $smtp -ports $smtpport -username $smtpuser -password $smtppassword"
+ eval $cmd_string
+ ns_log Debug "complex-send cmd_string: $cmd_string"
+ }
+ }
}
+
ad_proc -public valid_email_p {
{-email ""}
} {