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.14 -r1.15
--- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl 29 Jan 2007 17:16:50 -0000 1.14
+++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl 13 Sep 2007 13:52:05 -0000 1.15
@@ -127,16 +127,7 @@
}
} else {
ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Bounce checking $to, $user_id"
-
- if { ![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 {}
- }
- }
+ 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.70 -r1.71
--- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 29 Aug 2007 12:59:34 -0000 1.70
+++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 13 Sep 2007 13:52:05 -0000 1.71
@@ -183,7 +183,7 @@
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 || ![bouncing_email_p -email $rcpt] } {
+ 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"]
@@ -208,7 +208,7 @@
} -finally {
}
} else {
- ns_log Notice "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue"
+ 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 }
@@ -253,68 +253,74 @@
}
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] } {
- # 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 { $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
+ }
- if {[catch {
- _ns_smtp_send $wfp "RCPT TO:<$rcpt>" $timeout
+ 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
- } errmsg]} {
+ _ns_smtp_send $wfp "MAIL FROM:<$mail_from>" $timeout
+ _ns_smtp_recv $rfp 250 $timeout
- # 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 {}
+ # 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]} {
- if {![db_resultrows]} {
- db_dml insert_bounce {}
+ # 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
}
- 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
}
-
- _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 Notice "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue"
+ 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 }
@@ -438,7 +444,7 @@
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]
+ set send_p [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "send_immediately" -default 0]
}
if {$to_addr ne ""} {
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.4 -r1.5
--- openacs-4/packages/acs-mail-lite/tcl/bounce-procs.tcl 29 Aug 2007 12:59:34 -0000 1.4
+++ openacs-4/packages/acs-mail-lite/tcl/bounce-procs.tcl 13 Sep 2007 13:52:05 -0000 1.5
@@ -146,6 +146,25 @@
db_dml log_notication_sending {}
}
}
-
+ ad_proc -public record_bounce {
+ {-user_id ""}
+ {-email ""}
+ } {
+ 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 {}
+ }
+ }
+ }
+
}
Index: openacs-4/packages/acs-mail-lite/tcl/bounce-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/Attic/bounce-procs.xql,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-mail-lite/tcl/bounce-procs.xql 9 Apr 2007 06:18:17 -0000 1.1
+++ openacs-4/packages/acs-mail-lite/tcl/bounce-procs.xql 13 Sep 2007 13:52:05 -0000 1.2
@@ -57,4 +57,23 @@
+
+
+
+ update acs_mail_lite_bounce
+ set bounce_count = bounce_count + 1
+ where party_id = :user_id
+
+
+
+
+
+
+
+ insert into acs_mail_lite_bounce (party_id, bounce_count)
+ values (:user_id, 1)
+
+
+
+
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.8 -r1.9
--- openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 29 Aug 2007 12:59:34 -0000 1.8
+++ openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 13 Sep 2007 13:52:05 -0000 1.9
@@ -96,6 +96,8 @@
@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} {
@@ -172,7 +174,7 @@
{-no_callback_p ""}
{-extraheaders ""}
{-alternative_part_p ""}
- {-use_sender_p ""}
+ {-use_sender_p "0"}
} {
Prepare an email to be send immediately with the option to pass in a list
@@ -242,6 +244,7 @@
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 {
@@ -569,46 +572,54 @@
foreach email $recipient_list {
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 "$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
+ 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::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 "$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
+ 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
}
@@ -720,4 +731,22 @@
eval $cmd_string
}
+
+ ad_proc -public valid_email_p {
+ {-email ""}
+ } {
+ 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
+ }
+ }
}