Index: openacs-4/packages/notifications/notifications.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/notifications/notifications.info,v diff -u -r1.29.2.3 -r1.29.2.4 --- openacs-4/packages/notifications/notifications.info 22 Sep 2005 08:15:41 -0000 1.29.2.3 +++ openacs-4/packages/notifications/notifications.info 28 Sep 2005 18:22:01 -0000 1.29.2.4 @@ -8,14 +8,14 @@ t notifications - + OpenACS Email notifications management 2003-11-07 OpenACS Provides an API for packages to provide subscription based email notifications and handle replies. Used by forums, bug-tracker, etc. The currently prefered package for email notifications. - + Index: openacs-4/packages/notifications/tcl/notification-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/notifications/tcl/notification-callback-procs.tcl,v diff -u -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/notifications/tcl/notification-callback-procs.tcl 19 Jul 2005 22:38:47 -0000 1.1.2.1 +++ openacs-4/packages/notifications/tcl/notification-callback-procs.tcl 28 Sep 2005 18:22:01 -0000 1.1.2.2 @@ -36,3 +36,110 @@ return $result } +ad_proc -public -callback acs_mail_lite::incoming_email -impl notifications { + -array:required + -package_id +} { + Implementation of the interface acs_mail_lite::incoming_email for notifications. Notification + listens to replies sent out initially from notifications. According to the notification signature + -$object_id-$type_id@ it tries to figure out for which notification + type the email was from. The type corresponds to the service contract implementation. If the object_id + exists notification creates an entry in the table notification_email_hold and tries to inform implementations + of acs_mail_lite::incoming_email interested. Since the service contract NotificationType is implemented + only once for a package the table acs_mail_lite_reply_prefixes is used simply figure out which package corresponds + to the found type_id and has a valid package key. If a package key is found the callback implementation is + called. + + @author Nima Mazloumi (nima.mazloumi@gmx.de) + @creation-date 2005-07-15 + + @param array An array with all headers, files and bodies. To access the array you need to use upvar. + @param package_id The package instance that registered the prefix + @return nothing + @error +} { + upvar $array email + + set is_auto_reply_p 0 + + #TODO: we need to check if it Auto-Submitted header exists or "Out of Office AutoReply" in Subject + + if { $is_auto_reply_p } { + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: message $email(message-id) is from an auto-responder, skipping" + } + + set from [notification::email::parse_email_address $email(from)] + set to [notification::email::parse_email_address $email(to)] + + # Find the user_id of the sender + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: from $from" + set user_id [cc_lookup_email_user $from] + + # We don't accept empty users for now + if {[empty_string_p $user_id]} { + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: Unknown sender with email $from. Bouncing message." + # bounce message with an informative error. + notification::email::bounce_mail_message \ + -to_addr $from \ + -from_addr $to \ + -body $email(bodies) \ + -message_headers $email(headers) \ + -reason "Invalid sender. You must be a member of the site and\nyour From address must match your registered address." + return + } + + set to_stuff [notification::email::parse_reply_address -reply_address $to] + # We don't accept a bad incoming email address + if {[empty_string_p $to_stuff]} { + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: bad to address $to from $from. bouncing message." + + # bounce message here + notification::email::bounce_mail_message \ + -to_addr $from \ + -from_addr $to \ + -body $email(bodies) \ + -message_headers $email(headers) \ + -reason "Invalid To Address" + return + } + + set object_id [lindex $to_stuff 0] + set type_id [lindex $to_stuff 1] + set to_addr $to + set headers $email(headers) + set bodies $email(bodies) + + db_transaction { + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: Creating a reply for user: $user_id, object: object_id: $object_id, type_id: $type_id." + set reply_id [notification::reply::new \ + -object_id $object_id \ + -type_id $type_id \ + -from_user $user_id \ + -subject $email(subject) \ + -content $email(bodies)] + db_dml holdinsert {} + + #extending email array for notification callback implementors + set email(object_id) $object_id + set email(type_id) $type_id + set email(reply_id) $reply_id + set email(user_id) $user_id + + if {[db_0or1row select_impl {}]} { + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: calling notifications::incoming_email implementation for package $package_key" + if { [catch {callback -impl $package_key notifications::incoming_email -array email} error] } { + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: $error" + } + } else { + ns_log Notice "acs_mail_lite::incoming_email -impl notifications: No corresponding package registered for type_id $type_id" + } + + } on_error { + ns_log Error "acs_mail_lite::incoming_email -impl notifications: error inserting incoming email into the queue: $errmsg" + } +} + +ad_proc -public -callback notifications::incoming_email { + -array:required +} { +} Index: openacs-4/packages/notifications/tcl/notification-callback-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/notifications/tcl/notification-callback-procs.xql,v diff -u -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/notifications/tcl/notification-callback-procs.xql 19 Jul 2005 22:38:47 -0000 1.1.2.1 +++ openacs-4/packages/notifications/tcl/notification-callback-procs.xql 28 Sep 2005 18:22:01 -0000 1.1.2.2 @@ -26,4 +26,24 @@ + + + insert into notification_email_hold + (reply_id,to_addr,headers,body) + values + (:reply_id,:to_addr,:headers,:bodies) + + + + + + select sc.impl_owner_name as package_key from notification_types n, acs_sc_impls sc + where + n.sc_impl_id = sc.impl_id and + n.type_id = :type_id + limit 1 + + + Index: openacs-4/packages/notifications/tcl/reply-sweep-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/notifications/tcl/reply-sweep-init.tcl,v diff -u -r1.4 -r1.4.6.1 --- openacs-4/packages/notifications/tcl/reply-sweep-init.tcl 11 Dec 2003 21:40:09 -0000 1.4 +++ openacs-4/packages/notifications/tcl/reply-sweep-init.tcl 28 Sep 2005 18:22:01 -0000 1.4.6.1 @@ -10,11 +10,11 @@ # Roberto Mello (12/2002): Added parameter and check for qmail queue scanning -set scan_replies_p [parameter::get \ - -package_id [apm_package_id_from_key notifications] \ - -parameter EmailQmailQueueScanP -default 0] +#set scan_replies_p [parameter::get \ + -package_id [apm_package_id_from_key notifications] \ + -parameter EmailQmailQueueScanP -default 0] -if { $scan_replies_p == 1 } { - ad_schedule_proc -thread t 60 notification::reply::sweep::scan_all_replies - ad_schedule_proc -thread t 60 notification::reply::sweep::process_all_replies -} +#if { $scan_replies_p == 1 } { +# ad_schedule_proc -thread t 60 notification::reply::sweep::scan_all_replies +# ad_schedule_proc -thread t 60 notification::reply::sweep::process_all_replies +#}