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 -N -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: 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 -N --- openacs-4/packages/acs-mail-lite/tcl/bounce-procs.tcl 21 Jun 2018 15:21:23 -0000 1.22 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,107 +0,0 @@ -ad_library { - - Provides a simple API for reliably sending email. - - @author Eric Lorenzo (eric@openforce.net) - @creation-date 22 March 2002 - @cvs-id $Id: bounce-procs.tcl,v 1.22 2018/06/21 15:21:23 hectorr Exp $ - -} - -package require mime 1.4 -package require smtp 1.4 -package require base64 2.3.1 - -namespace eval acs_mail_lite { - - ad_proc -private 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 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 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 -# tcl-indent-level: 4 -# indent-tabs-mode: nil -# End: 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 -N --- openacs-4/packages/acs-mail-lite/tcl/bounce-procs.xql 21 Jun 2018 15:21:23 -0000 1.6 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,72 +0,0 @@ - - - - - - - select u.user_id, u.email, u.first_names || ' ' || u.last_name as name - from cc_users u, acs_mail_lite_bounce_notif n - where u.user_id = n.party_id - and u.email_bouncing_p = 't' - and n.notification_time < current_timestamp - interval :notification_interval day - and n.notification_count < :max_notification_count - - - - - - - - insert into acs_mail_lite_bounce_notif (party_id, notification_count, notification_time) - select party_id, 0 as notification_count, - current_date - (1 + cast(:notification_interval as integer)) as notification_time - from acs_mail_lite_bounce - where bounce_count >= :max_bounce_count - - - - - - - - update acs_mail_lite_bounce_notif - set notification_time = current_date, - notification_count = notification_count + 1 - where party_id = :user_id - - - - - - - - delete from acs_mail_lite_bounce - where party_id in (select party_id - from acs_mail_lite_mail_log - where last_mail_date < current_timestamp - interval :max_days_to_bounce day) - - - - - - - - update users - set email_bouncing_p = 't' - where user_id in (select party_id - from acs_mail_lite_bounce - where bounce_count >= :max_bounce_count) - - - - - - - - delete from acs_mail_lite_bounce - where bounce_count >= :max_bounce_count - - - - - 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 -N -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 Index: openacs-4/packages/acs-mail-lite/tcl/incoming-mail-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/Attic/incoming-mail-procs.tcl,v diff -u -N --- openacs-4/packages/acs-mail-lite/tcl/incoming-mail-procs.tcl 21 Jun 2018 15:21:23 -0000 1.19 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,54 +0,0 @@ -ad_library { - - Provides a simple API for reliably sending email. - - @author Eric Lorenzo (eric@openforce.net) - @creation-date 22 March 2002 - @cvs-id $Id: incoming-mail-procs.tcl,v 1.19 2018/06/21 15:21:23 hectorr Exp $ - -} - -package require mime 1.4 -package require smtp 1.4 -package require base64 2.3.1 -namespace eval acs_mail_lite { - - 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: -# mode: tcl -# tcl-indent-level: 4 -# indent-tabs-mode: nil -# End: