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.20 -r1.21 --- openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 10 Dec 2007 13:13:04 -0000 1.20 +++ openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 14 Dec 2007 19:21:49 -0000 1.21 @@ -154,6 +154,9 @@ {-to_party_ids ""} {-cc_party_ids ""} {-bcc_party_ids ""} + {-to_group_ids ""} + {-cc_group_ids ""} + {-bcc_group_ids ""} {-to_addr ""} {-cc_addr ""} {-bcc_addr ""} @@ -180,12 +183,18 @@ For backward compatibility a switch "single_email_p" is added. - @param to_party_ids list of party ids (including groups) to whom we send this email + @param to_party_ids list of party ids to whom we send this email - @param cc_party_ids list of party ids (including groups) to whom we send this email in "CC" + @param cc_party_ids list of party ids to whom we send this email in "CC" - @param bcc_party_ids list of party ids (including groups) to whom we send this email in "BCC" + @param bcc_party_ids list of party ids 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. @@ -228,32 +237,37 @@ set package_id $mail_package_id } - - ########################################### - # - # Prepare the sender and reply to address - # - ########################################### - - # We check if we need to use a fixed sender which overwrites - # the original sender + # We check if the parameter 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 } - # Get the party_id for the sender - set party_id($from_addr) [party::get_by_email -email $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" + } + } # 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] @@ -265,60 +279,9 @@ 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] @@ -364,28 +327,54 @@ # encode all attachments in base64 set tokens [list $message_token] + set item_ids [list] - ############# - # End of block to go in separate proc - ############# + if {[exists_and_not_null file_ids]} { - # 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] + 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 + } + } - # We have at least one attachment so change the type to multipart/mixed - if {[llength $attachment_tokens] > 0} { - set multi_token_type "multipart/mixed" - } + 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"] + } + } - ##################### - # - # 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 { @@ -408,113 +397,256 @@ 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) + } + } + } - ################### - # - # Send the e-mail - # - ################### + # 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 + } + } + } - - if { $single_email_p } { + 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 + } + } + } - ############################# - # - # One mail to all - # - ############################# + # 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 - # 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) + # 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 + } + } + } - 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 ","] - } + 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 + } + } + } - # 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 "[join $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 - } - } + 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 + } + } + } + # 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 @@ -539,9 +671,12 @@ # send the mail set err [catch { acs_mail_lite::complex_send_immediately \ - -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_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_addr $to_addr \ -cc_addr $cc_addr \ -bcc_addr $bcc_addr \ @@ -577,113 +712,11 @@ } } - 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. Takes care of rollout support + Send messages via SMTP @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}} @@ -713,31 +746,16 @@ set smtppassword [parameter::get -parameter "SMTPPassword" \ -package_id $mail_package_id] - - # 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" - } - } + 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 } - ad_proc -public valid_email_p { {-email ""} } { Index: openacs-4/packages/acs-subsite/tcl/party-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/Attic/party-procs.tcl,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-subsite/tcl/party-procs.tcl 5 Dec 2007 08:23:27 -0000 1.6 +++ openacs-4/packages/acs-subsite/tcl/party-procs.tcl 14 Dec 2007 19:23:41 -0000 1.7 @@ -283,46 +283,5 @@ } { return [db_string party_p {} -default 0] } - - ad_proc -private resolve_members { - -party_ids - {-single_p "1"} - } { - Get's a list of party_ids and resolves the groups to - individual parties. This should probably be written in - a recursive manner - - @author Malte Sussdorff - - @param party_ids Party_ids that need to be resolved - @param single_p Should the party only show up once even if it is in multiple groups - - @return list of party_ids where none of them is a group - } { - # Run through the party_ids and check if a group is in there. - set new_party_ids [list] - foreach party_id $party_ids { - if {[group::group_p -group_id $party_id]} { - foreach member_id [group::get_members -group_id $group_id] { - if {[group::group_p -group_id $member_id]} { - # This is a group, resolve it - acs_mail_lite::resolve_member -party_ids $member_id -single_p $single_p - } else { - lappend new_party_ids $member_id - } - } - } else { - lappend new_party_ids $party_id - } - } - - # If we only want to have the items of the list show up once - # We need to weed out duplicates - if {$single_p} { - return [lsort -unique $new_party_ids] - } else { - return $new_party_ids - } - } }