Index: openacs.org-dev/packages/notifications/tcl/notification-email-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/notifications/tcl/notification-email-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs.org-dev/packages/notifications/tcl/notification-email-procs.tcl 9 Jul 2002 17:35:10 -0000 1.1
+++ openacs.org-dev/packages/notifications/tcl/notification-email-procs.tcl 31 Oct 2002 10:52:18 -0000 1.2
@@ -25,14 +25,18 @@
return [get_parameter -name "EmailDomain"]
}
+ ad_proc -public manage_notifications_url {} {
+ return "[ad_url][apm_package_url_from_key [notification::package_key]]manage"
+ }
+
ad_proc -public reply_address_prefix {} {
return [get_parameter -name "EmailReplyAddressPrefix"]
}
ad_proc -private qmail_mail_queue_dir {} {
return [get_parameter -name "EmailQmailQueue"]
}
-
+
ad_proc -private parse_email_address {email} {
if {![regexp {<([^>]*)>} $email all clean_email]} {
return $email
@@ -46,9 +50,9 @@
{-type_id:required}
} {
if {[empty_string_p $object_id] || [empty_string_p $type_id]} {
- return [reply_address_prefix]
+ return "[address_domain] mailer <[reply_address_prefix]@[address_domain]>"
} else {
- return "[reply_address_prefix]-$object_id-$type_id@[address_domain]"
+ return "[address_domain] mailer <[reply_address_prefix]-$object_id-$type_id@[address_domain]>"
}
}
@@ -68,7 +72,6 @@
return [list $object_id $type_id]
}
-
ad_proc -public send {
to_user_id
reply_object_id
@@ -81,6 +84,8 @@
# Get email
set email [cc_email_from_party $to_user_id]
+ append content "\n\nGetting too much email? Manage your notifications at: [manage_notifications_url]"
+
acs_mail_lite::send \
-to_addr $email \
-from_addr [reply_address -object_id $reply_object_id -type_id $notification_type_id] \
@@ -91,12 +96,13 @@
ad_proc -private load_qmail_mail_queue {
{-queue_dir:required}
} {
- Scans qmail incoming email queue and queues up messages
- using acs-mail.
+ Scans qmail incoming email queue and queues up messages
+ using acs-mail.
- @Author dan.wickstrom@openforce.net, ben@openforce
+ @author ben@openforce.net
+ @author dan.wickstrom@openforce.net
@creation-date 22 Sept, 2001
-
+
@param queue_dir The location of the qmail mail queue in
the file-system.
} {
@@ -109,7 +115,7 @@
set list_of_reply_ids [list]
set new_messages_p 0
-
+
foreach msg $messages {
ns_log Notice "opening file: $msg"
if [catch {set f [open $msg r]}] {
@@ -118,13 +124,13 @@
set file [read $f]
close $f
set file [split $file "\n"]
-
+
set new_messages 1
set end_of_headers_p 0
set i 0
set line [lindex $file $i]
set headers [list]
-
+
# walk through the headers and extract each one
while ![empty_string_p $line] {
set next_line [lindex $file [expr $i + 1]]
@@ -134,31 +140,31 @@
if {[regexp {^([^:]+):[ ]+(.+)$} $line match name value]} {
# join headers that span more than one line (e.g. Received)
if { ![regexp {^([^:]+):[ ]+(.+)$} $next_line match] && !$end_of_headers_p} {
- append line $next_line
- incr i
+ append line $next_line
+ incr i
}
lappend headers [string tolower $name] $value
-
+
if {$end_of_headers_p} {
- incr i
- break
+ incr i
+ break
}
} else {
# The headers and the body are delimited by a null line as specified by RFC822
if {[regexp {^[ ]*$} $line match]} {
- incr i
- break
+ incr i
+ break
}
}
incr i
- set line [lindex $file $i]
+ set line [lindex $file $i]
}
set body "\n[join [lrange $file $i end] "\n"]"
-
- # okay now we have a list of headers and the body, let's
+
+ # okay now we have a list of headers and the body, let's
# put it into notifications stuff
array set email_headers $headers
-
+
if [catch {set from $email_headers(from)}] {
set from ""
}
@@ -180,7 +186,7 @@
}
continue
}
-
+
set to_stuff [parse_reply_address -reply_address $to]
# We don't accept a bad incoming email address
@@ -202,15 +208,15 @@
-from_user $from_user \
-subject $email_headers(subject) \
-content $body]
-
- catch {ns_unlink $msg}
+ catch {ns_unlink $msg}
+
lappend list_of_reply_ids $reply_id
} on_error {
ns_log Error "Error inserting incoming email into the queue"
}
}
-
+
return $list_of_reply_ids
}
Index: openacs.org-dev/packages/notifications/tcl/sweep-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs.org-dev/packages/notifications/tcl/sweep-init.tcl,v
diff -u -r1.2 -r1.3
--- openacs.org-dev/packages/notifications/tcl/sweep-init.tcl 11 Aug 2002 16:43:40 -0000 1.2
+++ openacs.org-dev/packages/notifications/tcl/sweep-init.tcl 31 Oct 2002 10:52:18 -0000 1.3
@@ -10,19 +10,19 @@
# Hack for now to test immediate deliveries
# FIXME
-#ad_schedule_proc -thread t 60 notification::sweep::cleanup_notifications
+ad_schedule_proc -thread t 60 notification::sweep::cleanup_notifications
-#foreach interval [notification::get_all_intervals] {
-# set n_seconds [lindex $interval 2]
-# if {$n_seconds > 0} {
-# set batched_p 1
-# } else {
-# set batched_p 0
-# }
-#
-# if {$n_seconds > 0} {
-# ad_schedule_proc -thread t $n_seconds notification::sweep::sweep_notifications -interval_id [lindex $interval 1] -batched_p $batched_p
-# } else {
-# ad_schedule_proc -thread t 60 notification::sweep::sweep_notifications -interval_id [lindex $interval 1] -batched_p $batched_p
-# }
-#}
+foreach interval [notification::get_all_intervals] {
+ set n_seconds [lindex $interval 2]
+ if {$n_seconds > 0} {
+ set batched_p 1
+ } else {
+ set batched_p 0
+ }
+
+ if {$n_seconds > 0} {
+ ad_schedule_proc -thread t $n_seconds notification::sweep::sweep_notifications -interval_id [lindex $interval 1] -batched_p $batched_p
+ } else {
+ ad_schedule_proc -thread t 60 notification::sweep::sweep_notifications -interval_id [lindex $interval 1] -batched_p $batched_p
+ }
+}