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 ""} } {