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.107 -r1.108
--- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 21 Jun 2018 13:12:17 -0000 1.107
+++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 21 Jun 2018 15:45:03 -0000 1.108
@@ -767,6 +767,38 @@
-extraheaders $extraheaders_list
}
+ ad_proc -public address_domain {} {
+ @return domain address to which bounces are directed to.
+ If empty, uses domain from FixedSenderEmail parameter,
+ otherwise the hostname in config.tcl is used.
+ } {
+ set domain [parameter::get_from_package_key \
+ -package_key "acs-mail-lite" \
+ -parameter "BounceDomain"]
+ if { $domain eq "" } {
+ # Assume a FixedSenderEmail domain, if it exists.
+ set email [parameter::get_from_package_key \
+ -package_key "acs-mail-lite" \
+ -parameter "FixedSenderEmail"]
+ if { $email ne "" } {
+ set domain [string range $email [string last "@" $email]+1 end]
+ } else {
+ #
+ # If there is no domain configured, use the configured
+ # hostname as domain name
+ #
+ foreach driver {nsssl nssock_v4 nssock_v6 nssock} {
+ set section [ns_driversection -driver $driver]
+ set configured_hostname [ns_config $section hostname]
+ if {$configured_hostname ne ""} {
+ set domain $configured_hostname
+ break
+ }
+ }
+ }
+ }
+ return $domain
+ }
}
# Local variables:
Fisheye: Tag 1.23 refers to a dead (removed) revision in file `openacs-4/packages/acs-mail-lite/tcl/bounce-procs.tcl'.
Fisheye: No comparison available. Pass `N' to diff?
Fisheye: Tag 1.7 refers to a dead (removed) revision in file `openacs-4/packages/acs-mail-lite/tcl/bounce-procs.xql'.
Fisheye: No comparison available. Pass `N' to diff?
Index: openacs-4/packages/acs-mail-lite/tcl/email-inbound-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/email-inbound-procs.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/acs-mail-lite/tcl/email-inbound-procs.tcl 14 Jun 2018 22:16:08 -0000 1.12
+++ openacs-4/packages/acs-mail-lite/tcl/email-inbound-procs.tcl 21 Jun 2018 15:45:03 -0000 1.13
@@ -2440,6 +2440,92 @@
return $ignore_p
}
+ad_proc -private acs_mail_lite::bounce_prefix {} {
+ @return bounce prefix for x-envelope-from
+} {
+ return [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "EnvelopePrefix"]
+}
+
+ad_proc -public acs_mail_lite::bouncing_user_p {
+ -user_id:required
+} {
+ Checks if email address of user is bouncing mail
+ @option user_id user to be checked for bouncing
+ @return boolean 1 if bouncing 0 if ok.
+} {
+ return [acs_user::get_element \
+ -user_id $user_id \
+ -element email_bouncing_p]
+}
+
+
+ad_proc -private acs_mail_lite::check_bounces {} {
+ Daily proc that sends out warning mail that emails
+ are bouncing and disables emails if necessary
+} {
+ set package_id [apm_package_id_from_key "acs-mail-lite"]
+ set max_bounce_count [parameter::get -package_id $package_id -parameter MaxBounceCount -default 10]
+ set max_days_to_bounce [parameter::get -package_id $package_id -parameter MaxDaysToBounce -default 3]
+ set notification_interval [parameter::get -package_id $package_id -parameter NotificationInterval -default 7]
+ set max_notification_count [parameter::get -package_id $package_id -parameter MaxNotificationCount -default 4]
+ set notification_sender [parameter::get -package_id $package_id -parameter NotificationSender -default "reminder@[address_domain]"]
+ if { $notification_sender eq "" } {
+ # Use the most specific default available
+ set fixed_sender [parameter::get -package_id $package_id -parameter "FixedSenderEmail"]
+ if { $fixed_sender ne "" } {
+ set notification_sender $fixed_sender
+ } elseif { [acs_mail_lite::utils::valid_email_p [ad_system_owner]] } {
+ set notification_sender [ad_system_owner]
+ } else {
+ # Set to an email address that is required to exist
+ # to avoid email loops and other issues
+ # per RFC 5321 section 4.5.1
+ # https://tools.ietf.org/html/rfc5321#section-4.5.1
+ # The somewhat unique capitalization may be useful
+ # for identifyng source in diagnostic context.
+ set notification_sender "PostMastER@[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 {}
+
+ # 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 {}
+
+ # now delete bounce log for users with disabled mail sending
+ db_dml delete_bouncing_users_from_log {}
+
+ set subject "[ad_system_name] Email Reminder"
+
+ # now periodically send notifications to users with
+ # disabled email to tell them how to re-enable 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)
+ set href [export_vars -base [ad_url]/register/restore-bounce {user_id}]
+ set body "Dear $user(name),\n\n\
+Due to returning mails from your email account, \n \
+we currently do not send you any email from our system.\n\n \
+To re-enable your email notifications, please visit\n${href}"
+
+ 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_notification_sending {}
+ }
+}
+
#
# Local variables:
# mode: tcl
Fisheye: Tag 1.20 refers to a dead (removed) revision in file `openacs-4/packages/acs-mail-lite/tcl/incoming-mail-procs.tcl'.
Fisheye: No comparison available. Pass `N' to diff?