Index: openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl,v diff -u -r1.15 -r1.16 --- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl 13 Sep 2007 13:52:05 -0000 1.15 +++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl 23 Nov 2007 16:19:16 -0000 1.16 @@ -28,8 +28,8 @@ } { Callback for executing code after an email has been send using the complex send mechanism. - - @param from_party_id Who is sending the email + + @param from_party_id Who is sending the email @param to_party_ids list of ids to whom did we send this email @@ -126,8 +126,8 @@ ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Invalid mail signature $signature" } } else { - ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Bounce checking $to, $user_id" - acs_mail_lite::record_bounce -user $user_id + ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Bounce checking $to, $user_id" + acs_mail_lite::record_bounce -user $user_id } } Index: openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl,v diff -u -r1.72 -r1.73 --- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 25 Sep 2007 15:22:37 -0000 1.72 +++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 23 Nov 2007 16:19:16 -0000 1.73 @@ -14,7 +14,7 @@ namespace eval acs_mail_lite { ad_proc -public get_package_id {} { - @returns package_id of this package + @returns package_id of this package } { return [apm_package_id_from_key acs-mail-lite] } @@ -23,49 +23,49 @@ -name:required {-default ""} } { - Returns an apm-parameter value of this package - @option name parameter name - @option default default parameter value - @returns apm-parameter value of this package + Returns an apm-parameter value of this package + @option name parameter name + @option default default parameter value + @returns apm-parameter value of this package } { return [parameter::get -package_id [get_package_id] -parameter $name -default $default] } ad_proc -public address_domain {} { - @returns domain address to which bounces are directed to + @returns domain address to which bounces are directed to } { set domain [get_parameter -name "BounceDomain"] if { [empty_string_p $domain] } { - regsub {http://} [ns_config ns/server/[ns_info server]/module/nssock hostname] {} domain - } - return $domain + regsub {http://} [ns_config ns/server/[ns_info server]/module/nssock hostname] {} domain + } + return $domain } ad_proc -private bounce_sendmail {} { - @returns path to the sendmail executable + @returns path to the sendmail executable } { - return [get_parameter -name "SendmailBin"] + return [get_parameter -name "SendmailBin"] } ad_proc -private bounce_prefix {} { - @returns bounce prefix for x-envelope-from + @returns bounce prefix for x-envelope-from } { return [get_parameter -name "EnvelopePrefix"] } ad_proc -private mail_dir {} { - @returns incoming mail directory to be scanned for bounces + @returns incoming mail directory to be scanned for bounces } { return [get_parameter -name "BounceMailDir"] } #--------------------------------------- ad_proc -public parse_email_address { - -email:required + -email:required } { - Extracts the email address out of a mail address (like Joe User ) - @option email mail address to be parsed - @returns only the email address part of the mail address + Extracts the email address out of a mail address (like Joe User ) + @option email mail address to be parsed + @returns only the email address part of the mail address } { if {![regexp {<([^>]*)>} $email all clean_email]} { return $email @@ -77,23 +77,23 @@ #--------------------------------------- ad_proc -private log_mail_sending { - -user_id:required + -user_id:required } { - Logs mail sending time for user - @option user_id user for whom email sending should be logged + Logs mail sending time for user + @option user_id user for whom email sending should be logged } { - db_dml record_mail_sent {} - if {![db_resultrows]} { - db_dml insert_log_entry {} - } + db_dml record_mail_sent {} + if {![db_resultrows]} { + db_dml insert_log_entry {} + } } #--------------------------------------- ad_proc -public generate_message_id { } { Generate an id suitable as a Message-Id: header for an email. - @returns valid message-id for mail header + @returns valid message-id for mail header } { # The combination of high resolution time and random # value should be pretty unique. @@ -103,56 +103,56 @@ #--------------------------------------- ad_proc -public valid_signature { - -signature:required - -message_id:required + -signature:required + -message_id:required } { Validates if provided signature matches message_id - @option signature signature to be checked - @option msg message-id that the signature should be checked against - @returns boolean 0 or 1 + @option signature signature to be checked + @option msg message-id that the signature should be checked against + @returns boolean 0 or 1 } { - if {![regexp "(<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)" $message_id match id] || $signature ne [ns_sha1 $id] } { - # either couldn't find message-id or signature doesn't match - return 0 - } - return 1 + if {![regexp "(<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)" $message_id match id] || $signature ne [ns_sha1 $id] } { + # either couldn't find message-id or signature doesn't match + return 0 + } + return 1 } #--------------------------------------- ad_proc -public deliver_mail { - -to_addr:required - -from_addr:required - -subject:required - -body:required - {-extraheaders ""} - {-bcc ""} - {-valid_email_p 0} - -package_id:required + -to_addr:required + -from_addr:required + -subject:required + -body:required + {-extraheaders ""} + {-bcc ""} + {-valid_email_p 0} + -package_id:required } { - Bounce Manager send - @option to_addr list of mail recipients - @option from_addr mail sender - @option subject mail subject - @option body mail body - @option extraheaders extra mail header - @option bcc list of recipients of a mail copy - @option valid_email_p flag if email needs to be checked if it's bouncing or - if calling code already made sure that the receiving email addresses - are not bouncing (this increases performance if mails are send in a batch process) - @option package_id package_id of the sending package - (needed to call package-specific code to deal with bounces) + Bounce Manager send + @option to_addr list of mail recipients + @option from_addr mail sender + @option subject mail subject + @option body mail body + @option extraheaders extra mail header + @option bcc list of recipients of a mail copy + @option valid_email_p flag if email needs to be checked if it's bouncing or + if calling code already made sure that the receiving email addresses + are not bouncing (this increases performance if mails are send in a batch process) + @option package_id package_id of the sending package + (needed to call package-specific code to deal with bounces) } { - set msg "Subject: $subject\nDate: [ns_httptime [ns_time]]" - - array set headers $extraheaders - set message_id $headers(Message-Id) + set msg "Subject: $subject\nDate: [ns_httptime [ns_time]]" + + array set headers $extraheaders + set message_id $headers(Message-Id) - foreach {key value} $extraheaders { - append msg "\n$key\: $value" - } + foreach {key value} $extraheaders { + append msg "\n$key\: $value" + } - ## Blank line between headers and body - append msg "\n\n$body\n" + ## Blank line between headers and body + append msg "\n\n$body\n" # ---------------------------------------------------- # Rollout support @@ -182,9 +182,9 @@ if {"." eq [string trim $line]} { append data . } - #AG: ensure no \r\r\n terminations. - set trimmed_line [string trimright $line \r] - append data "$trimmed_line\r\n" + #AG: ensure no \r\r\n terminations. + set trimmed_line [string trimright $line \r] + append data "$trimmed_line\r\n" } append data . @@ -206,257 +206,257 @@ #--------------------------------------- ad_proc -private sendmail { - -from_addr:required + -from_addr:required -sendlist:required - -msg:required - {-valid_email_p 0} - {-cc ""} - -message_id:required - -package_id:required + -msg:required + {-valid_email_p 0} + {-cc ""} + -message_id:required + -package_id:required } { - Sending mail through sendmail. - @option from_addr mail sender - @option sendlist list of mail recipients - @option msg mail to be sent (subject, header, body) - @option valid_email_p flag if email needs to be checked if it's bouncing or - if calling code already made sure that the receiving email addresses - are not bouncing (this increases performance if mails are send in a batch process) - @option message_id message-id of the mail - @option package_id package_id of the sending package - (needed to call package-specific code to deal with bounces) + Sending mail through sendmail. + @option from_addr mail sender + @option sendlist list of mail recipients + @option msg mail to be sent (subject, header, body) + @option valid_email_p flag if email needs to be checked if it's bouncing or + if calling code already made sure that the receiving email addresses + are not bouncing (this increases performance if mails are send in a batch process) + @option message_id message-id of the mail + @option package_id package_id of the sending package + (needed to call package-specific code to deal with bounces) } { - array set rcpts $sendlist - if {[info exists rcpts(email)]} { - foreach rcpt $rcpts(email) rcpt_id $rcpts(user_id) rcpt_name $rcpts(name) { - if { $valid_email_p || ([acs_mail_lite::valid_email_p -email $rcpt] && ![bouncing_email_p -email $rcpt]) } { - with_finally -code { - set sendmail [list [bounce_sendmail] "-f[bounce_address -user_id $rcpt_id -package_id $package_id -message_id $message_id]" "-t" "-i"] - - # add username if it exists - if {$rcpt_name ne ""} { - set pretty_to "$rcpt_name <$rcpt>" - } else { - set pretty_to $rcpt - } - - # substitute all "\r\n" with "\n", because piped text should only contain "\n" - regsub -all "\r\n" $msg "\n" msg - - if {[catch { - set err1 {} - set f [open "|$sendmail" "w"] - puts $f "From: $from_addr\nTo: $pretty_to\nCC: $cc\n$msg" - set err1 [close $f] - } err2]} { - ns_log Error "Attempt to send From: $from_addr\nTo: $pretty_to\n$msg failed.\nError $err1 : $err2" - } - } -finally { - } - } else { - ns_log Debug "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue" - } - # log mail sending time - if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id } - } - } + array set rcpts $sendlist + if {[info exists rcpts(email)]} { + foreach rcpt $rcpts(email) rcpt_id $rcpts(user_id) rcpt_name $rcpts(name) { + if { $valid_email_p || ([acs_mail_lite::valid_email_p -email $rcpt] && ![bouncing_email_p -email $rcpt]) } { + with_finally -code { + set sendmail [list [bounce_sendmail] "-f[bounce_address -user_id $rcpt_id -package_id $package_id -message_id $message_id]" "-t" "-i"] + + # add username if it exists + if {$rcpt_name ne ""} { + set pretty_to "$rcpt_name <$rcpt>" + } else { + set pretty_to $rcpt + } + + # substitute all "\r\n" with "\n", because piped text should only contain "\n" + regsub -all "\r\n" $msg "\n" msg + + if {[catch { + set err1 {} + set f [open "|$sendmail" "w"] + puts $f "From: $from_addr\nTo: $pretty_to\nCC: $cc\n$msg" + set err1 [close $f] + } err2]} { + ns_log Error "Attempt to send From: $from_addr\nTo: $pretty_to\n$msg failed.\nError $err1 : $err2" + } + } -finally { + } + } else { + ns_log Debug "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue" + } + # log mail sending time + if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id } + } + } } #--------------------------------------- ad_proc -private smtp { - -from_addr:required - -sendlist:required - -msg:required - {-valid_email_p 0} - -message_id:required - -package_id:required + -from_addr:required + -sendlist:required + -msg:required + {-valid_email_p 0} + -message_id:required + -package_id:required } { - Sending mail through smtp. - @option from_addr mail sender - @option sendlist list of mail recipients - @option msg mail to be sent (subject, header, body) - @option valid_email_p flag if email needs to be checked if it's bouncing or - if calling code already made sure that the receiving email addresses - are not bouncing (this increases performance if mails are send in a batch process) - @option message_id message-id of the mail - @option package_id package_id of the sending package - (needed to call package-specific code to deal with bounces) + Sending mail through smtp. + @option from_addr mail sender + @option sendlist list of mail recipients + @option msg mail to be sent (subject, header, body) + @option valid_email_p flag if email needs to be checked if it's bouncing or + if calling code already made sure that the receiving email addresses + are not bouncing (this increases performance if mails are send in a batch process) + @option message_id message-id of the mail + @option package_id package_id of the sending package + (needed to call package-specific code to deal with bounces) } { - set smtp [ns_config ns/parameters smtphost] - if {$smtp eq ""} { - set smtp [ns_config ns/parameters mailhost] - } - if {$smtp eq ""} { - set smtp localhost - } - set timeout [ns_config ns/parameters smtptimeout] - if {$timeout eq ""} { - set timeout 60 - } - set smtpport [ns_config ns/parameters smtpport] - if {$smtpport eq ""} { - set smtpport 25 - } - array set rcpts $sendlist + set smtp [ns_config ns/parameters smtphost] + if {$smtp eq ""} { + set smtp [ns_config ns/parameters mailhost] + } + if {$smtp eq ""} { + set smtp localhost + } + set timeout [ns_config ns/parameters smtptimeout] + if {$timeout eq ""} { + set timeout 60 + } + set smtpport [ns_config ns/parameters smtpport] + if {$smtpport eq ""} { + set smtpport 25 + } + array set rcpts $sendlist foreach rcpt $rcpts(email) rcpt_id $rcpts(user_id) rcpt_name $rcpts(name) { - if { $valid_email_p || ![bouncing_email_p -email $rcpt]} { - if {[acs_mail_lite::valid_email_p -email $rcpt]} { - # add username if it exists - if {$rcpt_name ne ""} { - set pretty_to "$rcpt_name <$rcpt>" - } else { - set pretty_to $rcpt - } - - set msg "From: $from_addr\r\nTo: $pretty_to\r\n$msg" - set mail_from [bounce_address -user_id $rcpt_id -package_id $package_id -message_id $message_id] - - ## Open the connection - set sock [ns_sockopen $smtp $smtpport] - set rfp [lindex $sock 0] - set wfp [lindex $sock 1] - - ## Perform the SMTP conversation - with_finally -code { - _ns_smtp_recv $rfp 220 $timeout - _ns_smtp_send $wfp "HELO [ns_info hostname]" $timeout - _ns_smtp_recv $rfp 250 $timeout - _ns_smtp_send $wfp "MAIL FROM:<$mail_from>" $timeout - _ns_smtp_recv $rfp 250 $timeout - - # By now we are sure that the server connection works, otherwise - # we would have gotten an error already - - if {[catch { - _ns_smtp_send $wfp "RCPT TO:<$rcpt>" $timeout - _ns_smtp_recv $rfp 250 $timeout - } errmsg]} { - - # This user has a problem with retrieving the email - # Record this fact as a bounce e-mail - if { $rcpt_id ne "" && ![bouncing_user_p -user_id $rcpt_id] } { - ns_log Notice "acs-mail-lite: Bouncing email from user $rcpt_id due to $errmsg" - # record the bounce in the database - db_dml record_bounce {} - - if {![db_resultrows]} { - db_dml insert_bounce {} - } - - } - - return - } - - _ns_smtp_send $wfp DATA $timeout - _ns_smtp_recv $rfp 354 $timeout - _ns_smtp_send $wfp $msg $timeout - _ns_smtp_recv $rfp 250 $timeout - _ns_smtp_send $wfp QUIT $timeout - _ns_smtp_recv $rfp 221 $timeout - - } -finally { - ## Close the connection - close $rfp - close $wfp - } - } else { - # email is invalid - ns_log Debug "Invalid E-Mail $rcpt" - acs_mail_lite::record_bounce -email $rcpt - } - } else { - ns_log Debug "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue" - } - # log mail sending time - if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id } - } + if { $valid_email_p || ![bouncing_email_p -email $rcpt]} { + if {[acs_mail_lite::valid_email_p -email $rcpt]} { + # add username if it exists + if {$rcpt_name ne ""} { + set pretty_to "$rcpt_name <$rcpt>" + } else { + set pretty_to $rcpt + } + + set msg "From: $from_addr\r\nTo: $pretty_to\r\n$msg" + set mail_from [bounce_address -user_id $rcpt_id -package_id $package_id -message_id $message_id] + + ## Open the connection + set sock [ns_sockopen $smtp $smtpport] + set rfp [lindex $sock 0] + set wfp [lindex $sock 1] + + ## Perform the SMTP conversation + with_finally -code { + _ns_smtp_recv $rfp 220 $timeout + _ns_smtp_send $wfp "HELO [ns_info hostname]" $timeout + _ns_smtp_recv $rfp 250 $timeout + _ns_smtp_send $wfp "MAIL FROM:<$mail_from>" $timeout + _ns_smtp_recv $rfp 250 $timeout + + # By now we are sure that the server connection works, otherwise + # we would have gotten an error already + + if {[catch { + _ns_smtp_send $wfp "RCPT TO:<$rcpt>" $timeout + _ns_smtp_recv $rfp 250 $timeout + } errmsg]} { + + # This user has a problem with retrieving the email + # Record this fact as a bounce e-mail + if { $rcpt_id ne "" && ![bouncing_user_p -user_id $rcpt_id] } { + ns_log Notice "acs-mail-lite: Bouncing email from user $rcpt_id due to $errmsg" + # record the bounce in the database + db_dml record_bounce {} + + if {![db_resultrows]} { + db_dml insert_bounce {} + } + + } + + return + } + + _ns_smtp_send $wfp DATA $timeout + _ns_smtp_recv $rfp 354 $timeout + _ns_smtp_send $wfp $msg $timeout + _ns_smtp_recv $rfp 250 $timeout + _ns_smtp_send $wfp QUIT $timeout + _ns_smtp_recv $rfp 221 $timeout + + } -finally { + ## Close the connection + close $rfp + close $wfp + } + } else { + # email is invalid + ns_log Debug "Invalid E-Mail $rcpt" + acs_mail_lite::record_bounce -email $rcpt + } + } else { + ns_log Debug "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue" + } + # log mail sending time + if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id } + } } #--------------------------------------- ad_proc -private get_address_array { - -addresses:required + -addresses:required } { Checks if passed variable is already an array of emails, - user_names and user_ids. If not, get the additional data - from the db and return the full array. - @option addresses variable to checked for array - @returns array of emails, user_names and user_ids to be used - for the mail procedures + user_names and user_ids. If not, get the additional data + from the db and return the full array. + @option addresses variable to checked for array + @returns array of emails, user_names and user_ids to be used + for the mail procedures } { - if {[catch {array set address_array $addresses}] - || ![string equal [lsort [array names address_array]] [list email name user_id]]} { + if {[catch {array set address_array $addresses}] + || ![string equal [lsort [array names address_array]] [list email name user_id]]} { - # either user just passed a normal address-list or - # user passed an array, but forgot to provide user_ids - # or user_names, so we have to get this data from the db + # either user just passed a normal address-list or + # user passed an array, but forgot to provide user_ids + # or user_names, so we have to get this data from the db - if {![info exists address_array(email)]} { - # so user passed on a normal address-list - set address_array(email) $addresses - } + if {![info exists address_array(email)]} { + # so user passed on a normal address-list + set address_array(email) $addresses + } - set address_list [list] - foreach email $address_array(email) { - # strip out only the emails from address-list - lappend address_list [string tolower [parse_email_address -email $email]] - } + set address_list [list] + foreach email $address_array(email) { + # strip out only the emails from address-list + lappend address_list [string tolower [parse_email_address -email $email]] + } - array unset address_array - # now get the user_names and user_ids - foreach email $address_list { - set email [string tolower $email] - if {[db_0or1row get_user_name_and_id ""]} { - lappend address_array(email) $email - lappend address_array(name) $user_name - lappend address_array(user_id) $user_id - } else { - lappend address_array(email) $email - lappend address_array(name) "" - lappend address_array(user_id) "" - } - } - } - return [array get address_array] + array unset address_array + # now get the user_names and user_ids + foreach email $address_list { + set email [string tolower $email] + if {[db_0or1row get_user_name_and_id ""]} { + lappend address_array(email) $email + lappend address_array(name) $user_name + lappend address_array(user_id) $user_id + } else { + lappend address_array(email) $email + lappend address_array(name) "" + lappend address_array(user_id) "" + } + } + } + return [array get address_array] } #--------------------------------------- ad_proc -public send { - -send_immediately:boolean - -valid_email:boolean + -send_immediately:boolean + -valid_email:boolean -to_addr:required -from_addr:required {-subject ""} -body:required {-extraheaders ""} {-bcc ""} - {-package_id ""} - -no_callback:boolean + {-package_id ""} + -no_callback:boolean } { Reliably send an email message. - @option send_immediately Switch that lets the mail send directly without adding it to the mail queue first. - @option valid_email Switch that avoids checking if the email to be mailed is not bouncing - @option to_addr List of mail-addresses or array of email,name,user_id containing lists of users to be mailed - @option from_addr mail sender - @option subject mail subject - @option body mail body - @option extraheaders extra mail headers in an ns_set - @option bcc see to_addr - @option package_id To be used for calling a package-specific proc when mail has bounced - @option no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks + @option send_immediately Switch that lets the mail send directly without adding it to the mail queue first. + @option valid_email Switch that avoids checking if the email to be mailed is not bouncing + @option to_addr List of mail-addresses or array of email,name,user_id containing lists of users to be mailed + @option from_addr mail sender + @option subject mail subject + @option body mail body + @option extraheaders extra mail headers in an ns_set + @option bcc see to_addr + @option package_id To be used for calling a package-specific proc when mail has bounced + @option no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks @returns the Message-Id of the mail or an empty string if e-mail was discarded } { - ## Extract "from" email address - set from_addr [parse_email_address -email $from_addr] + ## Extract "from" email address + set from_addr [parse_email_address -email $from_addr] - set from_party_id [party::get_by_email -email $from_addr] - set to_party_id [party::get_by_email -email $to_addr] - - ## Get address-array with email, name and user_id - set to_addr [get_address_array -addresses [string map {\n "" \r ""} $to_addr]] - if {$bcc ne ""} { - set bcc [get_address_array -addresses [string map {\n "" \r ""} $bcc]] - } + set from_party_id [party::get_by_email -email $from_addr] + set to_party_id [party::get_by_email -email $to_addr] + + ## Get address-array with email, name and user_id + set to_addr [get_address_array -addresses [string map {\n "" \r ""} $to_addr]] + if {$bcc ne ""} { + set bcc [get_address_array -addresses [string map {\n "" \r ""} $bcc]] + } if {$extraheaders ne ""} { set eh_list [util_ns_set_to_list -set $extraheaders] @@ -467,81 +467,81 @@ # Subject cannot contain newlines -- replace with spaces regsub -all {\n} $subject { } subject - set message_id [generate_message_id] + set message_id [generate_message_id] lappend eh_list "Message-Id" $message_id - if {$package_id eq ""} { - if {[ad_conn -connected_p]} { - set package_id [ad_conn package_id] - } else { - set package_id "" - } - } + if {$package_id eq ""} { + if {[ad_conn -connected_p]} { + set package_id [ad_conn package_id] + } else { + set package_id "" + } + } # Subject can not be longer than 200 characters if { [string length $subject] > 200 } { set subject "[string range $subject 0 196]..." } - # check, if send_immediately is set - # if not, take global parameter - if {$send_immediately_p} { - set send_p $send_immediately_p - } else { - # if parameter is not set, get the global setting - set send_p [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "send_immediately" -default 0] - } + # check, if send_immediately is set + # if not, take global parameter + if {$send_immediately_p} { + set send_p $send_immediately_p + } else { + # if parameter is not set, get the global setting + set send_p [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "send_immediately" -default 0] + } - if {$to_addr ne ""} { - # if send_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery - if { $send_p } { - acs_mail_lite::send_immediately -to_addr $to_addr -from_addr $from_addr -subject $subject -body $body -extraheaders $eh_list -bcc $bcc -valid_email_p $valid_email_p -package_id $package_id - } else { - # else, store it in the db and let the sweeper deliver the mail - db_dml create_queue_entry {} - } - - if { !$no_callback_p } { - callback acs_mail_lite::send \ - -package_id $package_id \ - -from_party_id $from_party_id \ - -to_party_id $to_party_id \ - -body $body \ - -message_id $message_id \ - -subject $subject - } - - return $message_id - } else { - return "" - } + if {$to_addr ne ""} { + # if send_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery + if { $send_p } { + acs_mail_lite::send_immediately -to_addr $to_addr -from_addr $from_addr -subject $subject -body $body -extraheaders $eh_list -bcc $bcc -valid_email_p $valid_email_p -package_id $package_id + } else { + # else, store it in the db and let the sweeper deliver the mail + db_dml create_queue_entry {} + } + + if { !$no_callback_p } { + callback acs_mail_lite::send \ + -package_id $package_id \ + -from_party_id $from_party_id \ + -to_party_id $to_party_id \ + -body $body \ + -message_id $message_id \ + -subject $subject + } + + return $message_id + } else { + return "" + } } #--------------------------------------- ad_proc -private sweeper {} { Send messages in the acs_mail_lite_queue table. } { - # Make sure that only one thread is processing the queue at a time. - if {[nsv_incr acs_mail_lite send_mails_p] > 1} { - nsv_incr acs_mail_lite send_mails_p -1 - return - } + # Make sure that only one thread is processing the queue at a time. + if {[nsv_incr acs_mail_lite send_mails_p] > 1} { + nsv_incr acs_mail_lite send_mails_p -1 + return + } - with_finally -code { - db_foreach get_queued_messages {} { - if { [catch {deliver_mail -to_addr $to_addr -from_addr $from_addr \ - -subject $subject -body $body -extraheaders $extra_headers \ - -bcc $bcc -valid_email_p $valid_email_p \ - -package_id $package_id} errmsg] } { - ns_log Error "acs_mail_lite::sweeper error sending to $to_addr:\n $errmsg\n" - } else { - db_dml delete_queue_entry {} + with_finally -code { + db_foreach get_queued_messages {} { + if { [catch {deliver_mail -to_addr $to_addr -from_addr $from_addr \ + -subject $subject -body $body -extraheaders $extra_headers \ + -bcc $bcc -valid_email_p $valid_email_p \ + -package_id $package_id} errmsg] } { + ns_log Error "acs_mail_lite::sweeper error sending to $to_addr:\n $errmsg\n" + } else { + db_dml delete_queue_entry {} + } } - } - } -finally { - nsv_incr acs_mail_lite send_mails_p -1 - } + } -finally { + nsv_incr acs_mail_lite send_mails_p -1 + } } #--------------------------------------- @@ -552,48 +552,48 @@ -body:required {-extraheaders ""} {-bcc ""} - {-valid_email_p 0} - -package_id:required + {-valid_email_p 0} + -package_id:required } { - Procedure to send mails immediately without queuing the mail in the database for performance reasons. - If ns_sendmail fails, the mail will be written in the db so the sweeper can send them out later. - @option to_addr List of mail-addresses or array of email,name,user_id containing lists of users to be mailed - @option from_addr mail sender - @option subject mail subject - @option body mail body - @option extraheaders extra mail headers - @option bcc see to_addr - @option valid_email_p Switch that avoids checking if the email to be mailed is not bouncing - @option package_id To be used for calling a package-specific proc when mail has bounced + Procedure to send mails immediately without queuing the mail in the database for performance reasons. + If ns_sendmail fails, the mail will be written in the db so the sweeper can send them out later. + @option to_addr List of mail-addresses or array of email,name,user_id containing lists of users to be mailed + @option from_addr mail sender + @option subject mail subject + @option body mail body + @option extraheaders extra mail headers + @option bcc see to_addr + @option valid_email_p Switch that avoids checking if the email to be mailed is not bouncing + @option package_id To be used for calling a package-specific proc when mail has bounced } { - if {[catch { - deliver_mail -to_addr $to_addr -from_addr $from_addr -subject $subject -body $body -extraheaders $extraheaders -bcc $bcc -valid_email_p $valid_email_p -package_id $package_id - } errmsg]} { - ns_log Error "acs_mail_lite::deliver_mail failed: $errmsg" - ns_log "Notice" "Mail info will be written in the db" - db_dml create_queue_entry {} - } else { - ns_log "Debug" "acs_mail_lite::deliver_mail successful" - } + if {[catch { + deliver_mail -to_addr $to_addr -from_addr $from_addr -subject $subject -body $body -extraheaders $extraheaders -bcc $bcc -valid_email_p $valid_email_p -package_id $package_id + } errmsg]} { + ns_log Error "acs_mail_lite::deliver_mail failed: $errmsg" + ns_log "Notice" "Mail info will be written in the db" + db_dml create_queue_entry {} + } else { + ns_log "Debug" "acs_mail_lite::deliver_mail successful" + } } #--------------------------------------- ad_proc -private message_interpolate { - {-values:required} - {-text:required} + {-values:required} + {-text:required} } { - Interpolates a set of values into a string. This is directly copied from the bulk mail package - - @param values a list of key, value pairs, each one consisting of a - target string and the value it is to be replaced with. - @param text the string that is to be interpolated - - @return the interpolated string + Interpolates a set of values into a string. This is directly copied from the bulk mail package + + @param values a list of key, value pairs, each one consisting of a + target string and the value it is to be replaced with. + @param text the string that is to be interpolated + + @return the interpolated string } { - foreach pair $values { - regsub -all [lindex $pair 0] $text [lindex $pair 1] text - } - return $text + foreach pair $values { + regsub -all [lindex $pair 0] $text [lindex $pair 1] text + } + return $text } #--------------------------------------- Index: openacs-4/packages/acs-mail-lite/tcl/bounce-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/Attic/bounce-procs.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/acs-mail-lite/tcl/bounce-procs.tcl 13 Sep 2007 13:52:05 -0000 1.5 +++ openacs-4/packages/acs-mail-lite/tcl/bounce-procs.tcl 23 Nov 2007 16:19:16 -0000 1.6 @@ -15,68 +15,68 @@ #--------------------------------------- ad_proc -private bounce_sendmail {} { - @returns path to the sendmail executable + @returns path to the sendmail executable } { - return [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "SendmailBin"] + return [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "SendmailBin"] } #--------------------------------------- ad_proc -private bounce_prefix {} { - @returns bounce prefix for x-envelope-from + @returns bounce prefix for x-envelope-from } { return [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "EnvelopePrefix"] } #--------------------------------------- ad_proc -public bouncing_email_p { - -email:required + -email:required } { - Checks if email address is bouncing mail - @option email email address to be checked for bouncing - @returns boolean 1 if bouncing 0 if ok. + Checks if email address is bouncing mail + @option email email address to be checked for bouncing + @returns boolean 1 if bouncing 0 if ok. } { - return [db_string bouncing_p {} -default 0] + return [db_string bouncing_p {} -default 0] } #--------------------------------------- ad_proc -public bouncing_user_p { - -user_id:required + -user_id:required } { - Checks if email address of user is bouncing mail - @option user_id user to be checked for bouncing - @returns boolean 1 if bouncing 0 if ok. + Checks if email address of user is bouncing mail + @option user_id user to be checked for bouncing + @returns boolean 1 if bouncing 0 if ok. } { - return [db_string bouncing_p {} -default 0] + return [db_string bouncing_p {} -default 0] } #--------------------------------------- ad_proc -public bounce_address { -user_id:required - -package_id:required - -message_id:required + -package_id:required + -message_id:required } { - Composes a bounce address - @option user_id user_id of the mail recipient - @option package_id package_id of the mail sending package - (needed to call package-specific code to deal with bounces) - @option message_id message-id of the mail - @returns bounce address + Composes a bounce address + @option user_id user_id of the mail recipient + @option package_id package_id of the mail sending package + (needed to call package-specific code to deal with bounces) + @option message_id message-id of the mail + @returns bounce address } { - return "[bounce_prefix]-$user_id-[ns_sha1 $message_id]-$package_id@[address_domain]" + return "[bounce_prefix]-$user_id-[ns_sha1 $message_id]-$package_id@[address_domain]" } #--------------------------------------- ad_proc -public parse_bounce_address { -bounce_address:required } { This takes a reply address, checks it for consistency, - and returns a list of user_id, package_id and bounce_signature found - @option bounce_address bounce address to be checked - @returns tcl-list of user_id package_id bounce_signature + and returns a list of user_id, package_id and bounce_signature found + @option bounce_address bounce address to be checked + @returns tcl-list of user_id package_id bounce_signature } { set regexp_str "\[[bounce_prefix]\]-(\[0-9\]+)-(\[^-\]+)-(\[0-9\]*)\@" if {![regexp $regexp_str $bounce_address all user_id signature package_id]} { - ns_log Debug "acs-mail-lite: bounce address not found for $bounce_address" + ns_log Debug "acs-mail-lite: bounce address not found for $bounce_address" return "" } return [list $user_id $package_id $signature] @@ -86,85 +86,85 @@ ad_proc -public scan_replies {} { Scheduled procedure that will scan for bounced mails } { - # Make sure that only one thread is processing the queue at a time. - if {[nsv_incr acs_mail_lite check_bounce_p] > 1} { - nsv_incr acs_mail_lite check_bounce_p -1 - return - } + # Make sure that only one thread is processing the queue at a time. + if {[nsv_incr acs_mail_lite check_bounce_p] > 1} { + nsv_incr acs_mail_lite check_bounce_p -1 + return + } - with_finally -code { - ns_log Debug "acs-mail-lite: about to load qmail queue for [mail_dir]" - load_mails -queue_dir [mail_dir] - } -finally { - nsv_incr acs_mail_lite check_bounce_p -1 - } + with_finally -code { + ns_log Debug "acs-mail-lite: about to load qmail queue for [mail_dir]" + load_mails -queue_dir [mail_dir] + } -finally { + nsv_incr acs_mail_lite check_bounce_p -1 + } } #--------------------------------------- ad_proc -private check_bounces { } { - Daily proc that sends out warning mail that emails - are bouncing and disables emails if necessary + Daily proc that sends out warning mail that emails + are bouncing and disables emails if necessary } { - set max_bounce_count [parameter::get_from_package_key -package_key "acs-mail-lite" -name MaxBounceCount -default 10] - set max_days_to_bounce [parameter::get_from_package_key -package_key "acs-mail-lite" -name MaxDaysToBounce -default 3] - set notification_interval [parameter::get_from_package_key -package_key "acs-mail-lite" -name NotificationInterval -default 7] - set max_notification_count [parameter::get_from_package_key -package_key "acs-mail-lite" -name MaxNotificationCount -default 4] - set notification_sender [parameter::get_from_package_key -package_key "acs-mail-lite" -name NotificationSender -default "reminder@[address_domain]"] + set max_bounce_count [parameter::get_from_package_key -package_key "acs-mail-lite" -name MaxBounceCount -default 10] + set max_days_to_bounce [parameter::get_from_package_key -package_key "acs-mail-lite" -name MaxDaysToBounce -default 3] + set notification_interval [parameter::get_from_package_key -package_key "acs-mail-lite" -name NotificationInterval -default 7] + set max_notification_count [parameter::get_from_package_key -package_key "acs-mail-lite" -name MaxNotificationCount -default 4] + set notification_sender [parameter::get_from_package_key -package_key "acs-mail-lite" -name NotificationSender -default "reminder@[address_domain]"] - # delete all bounce-log-entries for users who received last email - # X days ago without any bouncing (parameter) - db_dml delete_log_if_no_recent_bounce {} + # delete all bounce-log-entries for users who received last email + # X days ago without any bouncing (parameter) + db_dml delete_log_if_no_recent_bounce {} - # disable mail sending for users with more than X recently - # bounced mails - db_dml disable_bouncing_email {} + # disable mail sending for users with more than X recently + # bounced mails + db_dml disable_bouncing_email {} - # notify users of this disabled mail sending - db_dml send_notification_to_bouncing_email {} + # notify users of this disabled mail sending + db_dml send_notification_to_bouncing_email {} - # now delete bounce log for users with disabled mail sending - db_dml delete_bouncing_users_from_log {} + # now delete bounce log for users with disabled mail sending + db_dml delete_bouncing_users_from_log {} - set subject "[ad_system_name] Email Reminder" + set subject "[ad_system_name] Email Reminder" - # now periodically send notifications to users with - # disabled email to tell them how to reenable the email - set notifications [db_list_of_ns_sets get_recent_bouncing_users {}] + # now periodically send notifications to users with + # disabled email to tell them how to reenable the email + set notifications [db_list_of_ns_sets get_recent_bouncing_users {}] - # send notification to users with disabled email - foreach notification $notifications { - set notification_list [util_ns_set_to_list -set $notification] - array set user $notification_list - set user_id $user(user_id) + # send notification to users with disabled email + foreach notification $notifications { + set notification_list [util_ns_set_to_list -set $notification] + array set user $notification_list + set user_id $user(user_id) - set body "Dear $user(name),\n\nDue to returning mails from your email account, we currently do not send you any email from our system. To reenable your email account, please visit\n[ad_url]/register/restore-bounce?[export_url_vars user_id]" + set body "Dear $user(name),\n\nDue to returning mails from your email account, we currently do not send you any email from our system. To reenable your email account, please visit\n[ad_url]/register/restore-bounce?[export_url_vars user_id]" - send -to_addr $notification_list -from_addr $notification_sender -subject $subject -body $body -valid_email - ns_log Notice "Bounce notification send to user $user_id" + send -to_addr $notification_list -from_addr $notification_sender -subject $subject -body $body -valid_email + ns_log Notice "Bounce notification send to user $user_id" - # schedule next notification - db_dml log_notication_sending {} - } + # schedule next notification + db_dml log_notication_sending {} + } } ad_proc -public record_bounce { - {-user_id ""} - {-email ""} + {-user_id ""} + {-email ""} } { - Records that an email bounce for this user + Records that an email bounce for this user } { - if {$user_id eq ""} { - set user_id [party::get_by_email -email $email] - } - if { $user_id ne "" && ![acs_mail_lite::bouncing_user_p -user_id $user_id] } { - ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Bouncing email from user $user_id" - # record the bounce in the database - db_dml record_bounce {} - - if {![db_resultrows]} { - db_dml insert_bounce {} - } - } + if {$user_id eq ""} { + set user_id [party::get_by_email -email $email] + } + if { $user_id ne "" && ![acs_mail_lite::bouncing_user_p -user_id $user_id] } { + ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Bouncing email from user $user_id" + # record the bounce in the database + db_dml record_bounce {} + + if {![db_resultrows]} { + db_dml insert_bounce {} + } + } } } 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.11 -r1.12 --- openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 6 Nov 2007 07:49:47 -0000 1.11 +++ openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 23 Nov 2007 16:19:16 -0000 1.12 @@ -9,137 +9,137 @@ # 2006/11/17 modified (nfl) #--------------------------------------- ad_proc -public complex_send { - -send_immediately:boolean - -valid_email:boolean - {-to_party_ids ""} - {-cc_party_ids ""} - {-bcc_party_ids ""} - {-to_group_ids ""} - {-cc_group_ids ""} - {-bcc_group_ids ""} + -send_immediately:boolean + -valid_email:boolean + {-to_party_ids ""} + {-cc_party_ids ""} + {-bcc_party_ids ""} + {-to_group_ids ""} + {-cc_group_ids ""} + {-bcc_group_ids ""} {-to_addr ""} - {-cc_addr ""} - {-bcc_addr ""} + {-cc_addr ""} + {-bcc_addr ""} -from_addr:required - {-reply_to ""} + {-reply_to ""} {-subject ""} -body:required - {-package_id ""} - {-files ""} - {-file_ids ""} - {-folder_ids ""} - {-mime_type "text/plain"} - {-object_id ""} - {-single_email_p ""} - {-no_callback_p ""} - {-extraheaders ""} + {-package_id ""} + {-files ""} + {-file_ids ""} + {-folder_ids ""} + {-mime_type "text/plain"} + {-object_id ""} + {-single_email_p ""} + {-no_callback_p ""} + {-extraheaders ""} {-alternative_part_p ""} - -single_email:boolean - -no_callback:boolean - -use_sender:boolean + -single_email:boolean + -no_callback:boolean + -use_sender:boolean } { - Prepare an email to be send with the option to pass in a list - of file_ids as well as specify an html_body and a mime_type. It also supports multiple "TO" recipients as well as CC - and BCC recipients. Runs entirely off MIME and SMTP to achieve this. - For backward compatibility a switch "single_email_p" is added. + Prepare an email to be send with the option to pass in a list + of file_ids as well as specify an html_body and a mime_type. It also supports multiple "TO" recipients as well as CC + and BCC recipients. Runs entirely off MIME and SMTP to achieve this. + For backward compatibility a switch "single_email_p" is added. - @param send_immediately The email is send immediately and not stored in the acs_mail_lite_queue - - @param to_party_ids list of party ids to whom we send this email + @param send_immediately The email is send immediately and not stored in the acs_mail_lite_queue + + @param to_party_ids list of party ids 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 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 to whom we send this email in "BCC" - @param to_party_ids list of group_ids to whom we send this email + @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 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 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 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. - - @param subject of the email - - @param body Text body of the email - - @param cc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. + @param from_addr E-Mail address of the sender. We will try to figure out the name if possible. + + @param subject of the email + + @param body Text body of the email + + @param cc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. - @param bcc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. + @param bcc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. - @param package_id Package ID of the sending package - - @param files List of file_title, mime_type, file_path (as in full path to the file) combination of files to be attached + @param package_id Package ID of the sending package + + @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 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. + @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. - @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html". + @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html". - @param object_id The ID of the object that is responsible for sending the mail in the first place + @param object_id The ID of the object that is responsible for sending the mail in the first place - @param extraheaders List of keywords and their values passed in for headers. Interesting ones are: "Precedence: list" to disable autoreplies and mark this as a list message. This is as list of lists !! + @param extraheaders List of keywords and their values passed in for headers. Interesting ones are: "Precedence: list" to disable autoreplies and mark this as a list message. This is as list of lists !! - @param single_email Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). + @param single_email Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). - @param no_callback Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks - @param single_email_p Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). Used so we can set a variable in the callers environment to call complex_send. + @param no_callback Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks + @param single_email_p Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). Used so we can set a variable in the callers environment to call complex_send. - @param no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks. Used so we can set a variable in the callers environment to call complex_send. + @param no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks. Used so we can set a variable in the callers environment to call complex_send. - @param use_sender Boolean indicating that from_addr should be used regardless of fixed-sender parameter + @param use_sender Boolean indicating that from_addr should be used regardless of fixed-sender parameter @param alternative_part_p Boolean whether or not the code generates a multipart/alternative mail (text/html) } { - # Check if the e-mail is valid, meaning it contains at least an "@" sign - - # check, if send_immediately is set - # if not, take global parameter - if {$send_immediately_p} { - set send_p $send_immediately_p - } else { - # if parameter is not set, get the global setting - set send_p [parameter::get -package_id [get_package_id] -parameter "send_immediately" -default 0] - } + # Check if the e-mail is valid, meaning it contains at least an "@" sign + + # check, if send_immediately is set + # if not, take global parameter + if {$send_immediately_p} { + set send_p $send_immediately_p + } else { + # if parameter is not set, get the global setting + set send_p [parameter::get -package_id [get_package_id] -parameter "send_immediately" -default 0] + } - # if send_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery - if { $send_p } { - 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_addr $to_addr \ - -cc_addr $cc_addr \ - -bcc_addr $bcc_addr \ - -from_addr $from_addr \ - -reply_to $reply_to \ - -subject $subject \ - -body $body \ - -package_id $package_id \ - -files $files \ - -file_ids $file_ids \ - -folder_ids $folder_ids \ - -mime_type $mime_type \ - -object_id $object_id \ - -single_email_p $single_email_p \ - -no_callback_p $no_callback_p \ - -extraheaders $extraheaders \ - -alternative_part_p $alternative_part_p \ - -use_sender_p $use_sender_p - } else { - # else, store it in the db and let the sweeper deliver the mail - set creation_date [clock format [clock seconds] -format "%Y.%m.%d %H:%M:%S"] - set locking_server "" - db_dml create_complex_queue_entry {} - } + # if send_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery + if { $send_p } { + 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_addr $to_addr \ + -cc_addr $cc_addr \ + -bcc_addr $bcc_addr \ + -from_addr $from_addr \ + -reply_to $reply_to \ + -subject $subject \ + -body $body \ + -package_id $package_id \ + -files $files \ + -file_ids $file_ids \ + -folder_ids $folder_ids \ + -mime_type $mime_type \ + -object_id $object_id \ + -single_email_p $single_email_p \ + -no_callback_p $no_callback_p \ + -extraheaders $extraheaders \ + -alternative_part_p $alternative_part_p \ + -use_sender_p $use_sender_p + } else { + # else, store it in the db and let the sweeper deliver the mail + set creation_date [clock format [clock seconds] -format "%Y.%m.%d %H:%M:%S"] + set locking_server "" + db_dml create_complex_queue_entry {} + } } #--------------------------------------- @@ -150,151 +150,151 @@ # 2006/../.. Renamed to complex_send_immediately #--------------------------------------- ad_proc -public complex_send_immediately { - -valid_email:boolean - {-to_party_ids ""} - {-cc_party_ids ""} - {-bcc_party_ids ""} - {-to_group_ids ""} - {-cc_group_ids ""} - {-bcc_group_ids ""} + -valid_email:boolean + {-to_party_ids ""} + {-cc_party_ids ""} + {-bcc_party_ids ""} + {-to_group_ids ""} + {-cc_group_ids ""} + {-bcc_group_ids ""} {-to_addr ""} - {-cc_addr ""} - {-bcc_addr ""} + {-cc_addr ""} + {-bcc_addr ""} -from_addr:required - {-reply_to ""} + {-reply_to ""} {-subject ""} -body:required - {-package_id ""} - {-files ""} - {-file_ids ""} - {-folder_ids ""} - {-mime_type "text/plain"} - {-object_id ""} - {-single_email_p ""} - {-no_callback_p ""} - {-extraheaders ""} + {-package_id ""} + {-files ""} + {-file_ids ""} + {-folder_ids ""} + {-mime_type "text/plain"} + {-object_id ""} + {-single_email_p ""} + {-no_callback_p ""} + {-extraheaders ""} {-alternative_part_p ""} - {-use_sender_p "0"} + {-use_sender_p "0"} } { - Prepare an email to be send immediately with the option to pass in a list - of file_ids as well as specify an html_body and a mime_type. It also supports multiple "TO" recipients as well as CC - and BCC recipients. Runs entirely off MIME and SMTP to achieve this. - For backward compatibility a switch "single_email_p" is added. + Prepare an email to be send immediately with the option to pass in a list + of file_ids as well as specify an html_body and a mime_type. It also supports multiple "TO" recipients as well as CC + and BCC recipients. Runs entirely off MIME and SMTP to achieve this. + 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 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 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 to whom we send this email in "BCC" - @param to_party_ids list of group_ids to whom we send this email + @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 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 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 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. - - @param reply_to E-Mail address to which replies should go. Defaults to from_addr - - @param subject of the email - - @param body Text body of the email - - @param cc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. + @param from_addr E-Mail address of the sender. We will try to figure out the name if possible. + + @param reply_to E-Mail address to which replies should go. Defaults to from_addr + + @param subject of the email + + @param body Text body of the email + + @param cc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. - @param bcc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. + @param bcc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails. - @param package_id Package ID of the sending package - - @param files List of file_title, mime_type, file_path (as in full path to the file) combination of files to be attached + @param package_id Package ID of the sending package + + @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 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. + @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. - @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html". + @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html". - @param object_id The ID of the object that is responsible for sending the mail in the first place + @param object_id The ID of the object that is responsible for sending the mail in the first place - @param extraheaders List of keywords and their values passed in for headers. Interesting ones are: "Precedence: list" to disable autoreplies and mark this as a list message. This is as list of lists !! + @param extraheaders List of keywords and their values passed in for headers. Interesting ones are: "Precedence: list" to disable autoreplies and mark this as a list message. This is as list of lists !! - @param single_email Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). + @param single_email Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). - @param no_callback Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks - @param single_email_p Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). Used so we can set a variable in the callers environment to call complex_send. + @param no_callback Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks + @param single_email_p Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). Used so we can set a variable in the callers environment to call complex_send. - @param no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks. Used so we can set a variable in the callers environment to call complex_send. + @param no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks. Used so we can set a variable in the callers environment to call complex_send. - @param use_sender Boolean indicating that from_addr should be used regardless of fixed-sender parameter + @param use_sender Boolean indicating that from_addr should be used regardless of fixed-sender parameter @param alternative_part_p Boolean whether or not the code generates a multipart/alternative mail (text/html) } { - set mail_package_id [apm_package_id_from_key "acs-mail-lite"] - if {$package_id eq ""} { - set package_id $mail_package_id - } + set mail_package_id [apm_package_id_from_key "acs-mail-lite"] + if {$package_id eq ""} { + set package_id $mail_package_id + } - # We check if the parameter - set fixed_sender [parameter::get -parameter "FixedSenderEmail" \ - -package_id $mail_package_id] + # 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 - } + + 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" } { + if { $mime_type eq "text/plain" } { set alternative_part_p "0" } else { set alternative_part_p "1" } } - # Set the Reply-To + # Set the Reply-To if {$reply_to eq ""} { - set reply_to $sender_addr - } + 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] - if {[exists_and_not_null party_id($sender_addr)]} { - set from_string "\"[party::name -email $sender_addr]\" <${sender_addr}>" - set reply_to_string "\"[party::name -email $sender_addr]\" <${reply_to}>" - } else { - set from_string $sender_addr - set reply_to_string $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] + if {[exists_and_not_null party_id($sender_addr)]} { + set from_string "\"[party::name -email $sender_addr]\" <${sender_addr}>" + set reply_to_string "\"[party::name -email $sender_addr]\" <${reply_to}>" + } else { + set from_string $sender_addr + set reply_to_string $sender_addr + } - + # decision between normal or multipart/alternative body if { $alternative_part_p eq "0"} { - # Set the message token - set message_token [mime::initialize -canonical "$mime_type" -string "$body"] + # Set the message token + set message_token [mime::initialize -canonical "$mime_type" -string "$body"] } else { # build multipart/alternative - if { $mime_type eq "text/plain" } { - set message_text_part [mime::initialize -canonical "text/plain" -string "$body"] + if { $mime_type eq "text/plain" } { + set message_text_part [mime::initialize -canonical "text/plain" -string "$body"] set converted [ad_text_to_html "$body"] set message_html_part [mime::initialize -canonical "text/html" -string "$converted"] } else { - set message_html_part [mime::initialize -canonical "text/html" -string "$body"] + set message_html_part [mime::initialize -canonical "text/html" -string "$body"] set converted [ad_html_to_text "$body"] set message_text_part [mime::initialize -canonical "text/plain" -string "$converted"] } @@ -303,327 +303,327 @@ } - # encode all attachments in base64 - - set tokens [list $message_token] - set item_ids [list] + # encode all attachments in base64 + + set tokens [list $message_token] + set item_ids [list] - if {[exists_and_not_null file_ids]} { + 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 - } - } + # 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 + 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"] - } - } + 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 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 - } - } - } + # 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 + } + } + } - #### Now we start with composing the mail message #### + #### Now we start with composing the mail message #### - set multi_token [mime::initialize -canonical multipart/mixed -parts "$tokens"] + set multi_token [mime::initialize -canonical multipart/mixed -parts "$tokens"] - # Set the message_id - set message_id "[mime::uniqueID]" - mime::setheader $multi_token "message-id" "[mime::uniqueID]" - - # Set the date - mime::setheader $multi_token date "[mime::parsedatetime -now proper]" + # Set the message_id + set message_id "[mime::uniqueID]" + mime::setheader $multi_token "message-id" "[mime::uniqueID]" + + # Set the date + mime::setheader $multi_token date "[mime::parsedatetime -now proper]" - # 2006/09/25 nfl/cognovis - # subject: convert 8-bit characters into MIME encoded words - # see http://tools.ietf.org/html/rfc2047 - - #set subject_encoded [mime::word_encode "iso8859-1" base64 $subject] - #regsub -all {\n} $subject_encoded {} subject_encoded - #mime::setheader $multi_token Subject "$subject_encoded" - mime::setheader $multi_token Subject "$subject" + # 2006/09/25 nfl/cognovis + # subject: convert 8-bit characters into MIME encoded words + # see http://tools.ietf.org/html/rfc2047 + + #set subject_encoded [mime::word_encode "iso8859-1" base64 $subject] + #regsub -all {\n} $subject_encoded {} subject_encoded + #mime::setheader $multi_token Subject "$subject_encoded" + mime::setheader $multi_token Subject "$subject" - foreach header $extraheaders { - mime::setheader $multi_token "[lindex $header 0]" "[lindex $header 1]" - } + foreach header $extraheaders { + mime::setheader $multi_token "[lindex $header 0]" "[lindex $header 1]" + } - set packaged [mime::buildmessage $multi_token] + set packaged [mime::buildmessage $multi_token] # Now the To recipients - set to_list [list] + 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) - } - } - } + 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 - } - } - } + # 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 + } + } + } - 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 - } - } - } + 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 + # 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] + # 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) - } - } - } + 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 - } - } - } + # 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 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 - } - } - } + 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 + # 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] + # 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) - } - } - } + 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 - } - } - } + # 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 + } + } + } - 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 - } - } - } + 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 + # 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) + # 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 { + 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 - # - ############################# + 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 ","] + # 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]>" - } + # 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 - } + + 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 - # - #################################################################### + + } 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] + # 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 - } - } + 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 - } - } + # 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 + } + } } #--------------------------------------- @@ -641,50 +641,50 @@ with_finally -code { db_foreach get_complex_queued_messages {} { - # check if record is already there and free to use - set return_id [db_string get_complex_queued_message {} -default -1] - if {$return_id == $id} { - # lock this record for exclusive use - set locking_server [ad_url] - db_dml lock_queued_message {} - # 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_addr $to_addr \ - -cc_addr $cc_addr \ - -bcc_addr $bcc_addr \ - -from_addr $from_addr \ - -reply_to $reply_to \ - -subject $subject \ - -body $body \ - -package_id $package_id \ - -files $files \ - -file_ids $file_ids \ - -folder_ids $folder_ids \ - -mime_type $mime_type \ - -object_id $object_id \ - -single_email_p $single_email_p \ - -no_callback_p $no_callback_p \ - -extraheaders $extraheaders \ - -alternative_part_p $alternative_part_p \ - -use_sender_p $use_sender_p - } errMsg] - if {$err} { - ns_log Error "Error while sending queued complex mail: $errMsg" - # release the lock - set locking_server "" - db_dml lock_queued_message {} - } else { - # mail was sent, delete the queue entry - db_dml delete_complex_queue_entry {} - } - } + # check if record is already there and free to use + set return_id [db_string get_complex_queued_message {} -default -1] + if {$return_id == $id} { + # lock this record for exclusive use + set locking_server [ad_url] + db_dml lock_queued_message {} + # 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_addr $to_addr \ + -cc_addr $cc_addr \ + -bcc_addr $bcc_addr \ + -from_addr $from_addr \ + -reply_to $reply_to \ + -subject $subject \ + -body $body \ + -package_id $package_id \ + -files $files \ + -file_ids $file_ids \ + -folder_ids $folder_ids \ + -mime_type $mime_type \ + -object_id $object_id \ + -single_email_p $single_email_p \ + -no_callback_p $no_callback_p \ + -extraheaders $extraheaders \ + -alternative_part_p $alternative_part_p \ + -use_sender_p $use_sender_p + } errMsg] + if {$err} { + ns_log Error "Error while sending queued complex mail: $errMsg" + # release the lock + set locking_server "" + db_dml lock_queued_message {} + } else { + # mail was sent, delete the queue entry + db_dml delete_complex_queue_entry {} + } + } } } -finally { nsv_incr acs_mail_lite complex_send_mails_p -1 @@ -701,29 +701,29 @@ @param headers List of list of header key-value pairs like {{from malte@cognovis.de} {to malte@cognovis.de}} } { - set mail_package_id [apm_package_id_from_key "acs-mail-lite"] + set mail_package_id [apm_package_id_from_key "acs-mail-lite"] # Get the SMTP Parameters set smtp [parameter::get -parameter "SMTPHost" \ - -package_id $mail_package_id -default [ns_config ns/parameters mailhost]] + -package_id $mail_package_id -default [ns_config ns/parameters mailhost]] if {$smtp eq ""} { set smtp localhost } set timeout [parameter::get -parameter "SMTPTimeout" \ - -package_id $mail_package_id -default [ns_config ns/parameters smtptimeout]] + -package_id $mail_package_id -default [ns_config ns/parameters smtptimeout]] if {$timeout eq ""} { set timeout 60 } set smtpport [parameter::get -parameter "SMTPPort" \ - -package_id $mail_package_id -default 25] + -package_id $mail_package_id -default 25] set smtpuser [parameter::get -parameter "SMTPUser" \ - -package_id $mail_package_id] + -package_id $mail_package_id] set smtppassword [parameter::get -parameter "SMTPPassword" \ - -package_id $mail_package_id] + -package_id $mail_package_id] set cmd_string "smtp::sendmessage $multi_token" foreach header $headers { @@ -736,20 +736,20 @@ } ad_proc -public valid_email_p { - {-email ""} + {-email ""} } { - Checks if the email is valid. Returns 1 if it is. Uses mime::parsemail to determine this + Checks if the email is valid. Returns 1 if it is. Uses mime::parsemail to determine this } { - array set test [lindex [mime::parseaddress "$email"] 0] - if {$email ne $test(proper)} { - regsub "\"" $test(proper) "" proper - if {$email ne $proper} { - return 0 - } else { - return 1 - } - } else { - return 1 - } + array set test [lindex [mime::parseaddress "$email"] 0] + if {$email ne $test(proper)} { + regsub "\"" $test(proper) "" proper + if {$email ne $proper} { + return 0 + } else { + return 1 + } + } else { + return 1 + } } }