Skip to content

A
acs-mail-lite
Commit 0fd18113 authored by Frank Bergmann's avatar Frank Bergmann
Browse files
Options

- Comitting OpenACS 5.9

parent 4adecd51
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 246 additions and 171 deletions
acs-mail-lite.info
View file @ 0fd18113
This diff is collapsed.
sql/oracle/acs-mail-lite-create.sql
View file @ 0fd18113
......@@ -8,31 +8,33 @@
create sequence acs_mail_lite_id_seq;
CREATE TABLE acs_mail_lite_queue (
message_id integer
constraint acs_mail_lite_queue_pk
PRIMARY KEY,
creation_date varchar(4000),
locking_server varchar(4000),
to_addr varchar(4000),
cc_addr clob,
bcc_addr clob,
from_addr varchar(400),
reply_to varchar(400),
subject varchar(4000),
body clob,
package_id integer
constraint amlq_package_id_fk
references apm_packages,
file_ids varchar(4000),
mime_type varchar(200),
object_id integer,
no_callback_p char(1)
constraint amlq_no_callback_p_ck
check (no_callback_p in ('t','f')),
extraheaders clob,
use_sender_p char(1)
constraint amlq_use_sender_p_ck
check (use_sender_p in ('t','f'))
message_id integer
constraint acs_mail_lite_queue_pk
PRIMARY KEY,
creation_date varchar(4000),
locking_server varchar(4000),
to_addr varchar(4000),
cc_addr clob,
bcc_addr clob,
from_addr varchar(400),
reply_to varchar(400),
subject varchar(4000),
body clob,
package_id integer
constraint amlq_package_id_fk
references apm_packages,
file_ids varchar(4000),
filesystem_files varchar(4000),
delete_filesystem_files_p boolean,
mime_type varchar(200),
object_id integer,
no_callback_p char(1)
constraint amlq_no_callback_p_ck
check (no_callback_p in ('t','f')),
extraheaders clob,
use_sender_p char(1)
constraint amlq_use_sender_p_ck
check (use_sender_p in ('t','f'))
);
create table acs_mail_lite_mail_log (
......
sql/postgresql/acs-mail-lite-create.sql
View file @ 0fd18113
......@@ -8,27 +8,29 @@
create sequence acs_mail_lite_id_seq;
CREATE TABLE acs_mail_lite_queue (
message_id integer
constraint acs_mail_lite_queue_pk
primary key,
creation_date text,
locking_server text,
to_addr text,
cc_addr text,
bcc_addr text,
from_addr text,
reply_to text,
subject text,
body text,
package_id integer
constraint amlq_package_id_fk
references apm_packages,
file_ids text,
mime_type text,
object_id integer,
no_callback_p boolean,
extraheaders text,
use_sender_p boolean
message_id integer
constraint acs_mail_lite_queue_pk
primary key,
creation_date text,
locking_server text,
to_addr text,
cc_addr text,
bcc_addr text,
from_addr text,
reply_to text,
subject text,
body text,
package_id integer
constraint amlq_package_id_fk
references apm_packages,
file_ids text,
filesystem_files text,
delete_filesystem_files_p boolean,
mime_type text,
object_id integer,
no_callback_p boolean,
extraheaders text,
use_sender_p boolean
);
create table acs_mail_lite_mail_log (
......
tcl/acs-mail-lite-callback-procs.tcl
View file @ 0fd18113
......@@ -21,6 +21,8 @@ ad_proc -public -callback acs_mail_lite::send {
{-cc_addr}
{-bcc_addr}
{-file_ids}
{-filesystem_files}
{-delete_filesystem_files_p}
{-object_id}
} {
......@@ -99,7 +101,7 @@ ad_proc -public -callback acs_mail_lite::incoming_email -impl acs-mail-lite {
set to [acs_mail_lite::parse_email_address -email $email(to)]
ns_log Debug "acs_mail_lite::incoming_email -impl acs-mail-lite called. Recepient $to"
util_unlist [acs_mail_lite::parse_bounce_address -bounce_address $to] user_id package_id signature
lassign [acs_mail_lite::parse_bounce_address -bounce_address $to] user_id package_id signature
# If no user_id found or signature invalid, ignore message
if {$user_id eq ""} {
......
tcl/acs-mail-lite-init.tcl
View file @ 0fd18113
......@@ -28,9 +28,6 @@ nsv_set acs_mail_lite check_bounce_p 0
# Redefine ns_sendmail as a wrapper for acs_mail_lite::send
ns_log Notice "acs-mail-lite: renaming acs_mail_lite::sendmail to ns_sendmail"
rename ns_sendmail _old_ns_sendmail
rename acs_mail_lite::sendmail ns_sendmail
#ns_log Notice "acs-mail-lite: renaming acs_mail_lite::sendmail to ns_sendmail"
#rename ns_sendmail _old_ns_sendmail
#rename acs_mail_lite::sendmail ns_sendmail
tcl/acs-mail-lite-procs-oracle.xql
View file @ 0fd18113
......@@ -15,6 +15,8 @@
subject,
package_id,
file_ids,
filesystem_files,
delete_filesystem_files_p,
mime_type,
no_callback_p,
use_sender_p,
......@@ -34,6 +36,8 @@
:subject,
:package_id,
:file_ids,
:filesystem_files,
decode(:delete_filesystem_files_p,'1','t','f'),,
:mime_type,
decode(:no_callback_p,'1','t','f'),
decode(:use_sender_p,'1','t','f'),
......@@ -80,6 +84,8 @@
body,
package_id,
file_ids,
filesystem_files,
delete_filesystem_files_p,
mime_type,
decode(no_callback_p,'t',1,0) as no_callback_p,
extraheaders,
......
tcl/acs-mail-lite-procs-postgresql.xql
View file @ 0fd18113
......@@ -18,6 +18,8 @@
body,
package_id,
file_ids,
filesystem_files,
delete_filesystem_files_p,
mime_type,
no_callback_p,
extraheaders,
......@@ -37,6 +39,8 @@
:body,
:package_id,
:file_ids,
:filesystem_files,
(case when :delete_filesystem_files_p = '1' then TRUE else FALSE end),
:mime_type,
(case when :no_callback_p = '1' then TRUE else FALSE end),
:extraheaders,
......@@ -81,6 +85,8 @@
body,
package_id,
file_ids,
(case when delete_filesystem_files_p = TRUE then 1 else 0 end) as delete_filesystem_files_p,
filesystem_files,
mime_type,
(case when no_callback_p = TRUE then 1 else 0 end) as no_callback_p,
extraheaders,
......
tcl/acs-mail-lite-procs.tcl
View file @ 0fd18113
This diff is collapsed.
tcl/bounce-procs.tcl
View file @ 0fd18113
......@@ -129,8 +129,8 @@ namespace eval acs_mail_lite {
set notification_list [util_ns_set_to_list -set $notification]
array set user $notification_list
set user_id $user(user_id)
set body "Dear $user(name),\n\nDue to returning mails from your email account, we currently do not send you any email from our system. To reenable your email account, please visit\n[ad_url]/register/restore-bounce?[export_url_vars user_id]"
set href [export_vars -base [ad_url]/register/restore-bounce {user_id}]
set body "Dear $user(name),\n\nDue to returning mails from your email account, we currently do not send you any email from our system. To reenable your email account, 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"
......
tcl/incoming-mail-procs.tcl
View file @ 0fd18113
......@@ -19,7 +19,7 @@ namespace eval acs_mail_lite {
} {
set domain [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "BounceDomain"]
if { $domain eq "" } {
regsub {http://} [ns_config ns/server/[ns_info server]/module/nssock hostname] {} domain
regsub {http://} [ns_config [ns_driversection -driver nssock] hostname] _ domain
}
return $domain
}
......@@ -29,21 +29,21 @@ namespace eval acs_mail_lite {
ad_proc -private load_mails {
-queue_dir:required
} {
Scans for incoming email. You need
An incoming email has to comply to the following syntax rule:
[<SitePrefix>][-]<ReplyPrefix>-Whatever@<BounceDomain>
Scans for incoming email. The function requires
incoming emails that comply to the following syntax rule:
<pre>
[&lt;SitePrefix&gt;][-]&lt;ReplyPrefix&gt;-Whatever@&lt;BounceDomain&gt;
[] = optional
<> = Package Parameters
</pre>
If no SitePrefix is set we assume that there is only one OpenACS installation. Otherwise
only messages are dealt with which contain a SitePrefix.
<p>
ReplyPrefixes are provided by packages that implement the callback acs_mail_lite::incoming_email
and provide a package parameter called ReplyPrefix. Only implementations are considered where the
implementation name is equal to the package key of the package.
<p>
Also we only deal with messages that contain a valid and registered ReplyPrefix.
These prefixes are automatically set in the acs_mail_lite_prefixes table.
......@@ -108,7 +108,7 @@ namespace eval acs_mail_lite {
}
#let's delete the file now
if {[catch {ns_unlink $msg} errmsg]} {
if {[catch {file delete $msg} errmsg]} {
ns_log Error "load_mails: unable to delete queued message $msg: $errmsg"
} else {
ns_log Debug "load_mails: deleted $msg"
......@@ -164,7 +164,6 @@ namespace eval acs_mail_lite {
@creation-date 2005-07-15
} {
upvar $array email
#prepare the message
......@@ -173,15 +172,14 @@ namespace eval acs_mail_lite {
set stream [open $file]
set content [read $stream]
close $stream
ns_log error "$content"
ns_unlink $file
ns_log error $content
file delete $file
return
}
#get the content type
set content [mime::getproperty $mime content]
ns_log NOTICE "incoming-mail-procs::parse_email: Content: $content"
#get all available headers
set keys [mime::getheader $mime -names]
......@@ -198,25 +196,19 @@ namespace eval acs_mail_lite {
#check for multipart, otherwise we only have one part
if { [string first "multipart" $content] != -1 } {
# ns_log NOTICE "incoming-mail-procs::parse_email: Found multipart"
set parts [mime::getproperty $mime parts]
} else {
# ns_log NOTICE "incoming-mail-procs::parse_email: Multipart not found"
set parts [list $mime]
}
# travers the tree and extract parts into a flat list
set all_parts [list]
foreach part $parts {
ns_log NOTICE "incoming-mail-procs::parse_email: Centent Property of Part: [mime::getproperty $part content]"
if {[mime::getproperty $part content] eq "multipart/alternative" || [mime::getproperty $part content] eq "multipart/mixed" } {
if {[mime::getproperty $part content] eq "multipart/alternative"} {
foreach child_part [mime::getproperty $part parts] {
# ns_log NOTICE "incoming-mail-procs::parse_email: Adding to all_parts (child): $child_part "
lappend all_parts $child_part
}
} else {
# ns_log NOTICE "incoming-mail-procs::parse_email: Adding to all_parts (main): $part "
lappend all_parts $part
}
}
......@@ -224,52 +216,36 @@ namespace eval acs_mail_lite {
set bodies [list]
set files [list]
foreach part $all_parts {
ns_log NOTICE "incoming-mail-procs::parse_email: CONTENT for $part: [mime::getproperty $part content]"
ns_log NOTICE "incoming-mail-procs::parse_email: BUILDMMESSAGE for $part: [mime::buildmessage $part]"
ns_log NOTICE "incoming-mail-procs::parse_email: CONTENT DISPOSITION: [catch {[mime::getheader $part Content-disposition]} errmsg] { $errmsg }"
}
#now extract all parts (bodies/files) and fill the email array
foreach part $all_parts {
# ns_log NOTICE "incoming-mail-procs::parse_email: Now working on part: $part"
# Attachments have a "Content-disposition" part
# Therefore we filter out if it is an attachment here
if {[catch {mime::getheader $part Content-disposition}] || [mime::getheader $part Content-disposition] eq "inline"} {
# ns_log NOTICE "incoming-mail-procs::parse_email: Entering Bodies .... "
if [catch {
switch [mime::getproperty $part content] {
"text/plain" {
lappend bodies [list "text/plain" [mime::getbody $part]]
}
"text/html" {
lappend bodies [list "text/html" [mime::getbody $part]]
}
switch [mime::getproperty $part content] {
"text/plain" {
lappend bodies [list "text/plain" [mime::getbody $part]]
}
"text/html" {
lappend bodies [list "text/html" [mime::getbody $part]]
}
} errmsg] {
ns_log NOTICE "incoming-mail-procs::parse_email: Error evaluating mail body: $errmsg"
}
} else {
# ns_log NOTICE "incoming-mail-procs::parse_email: Entering Attachments .... "
set encoding [mime::getproperty $part encoding]
set body [mime::getbody $part -decode]
set content $body
set params [mime::getproperty $part params]
# ns_log NOTICE "incoming-mail-procs::parse_email: Params: $params"
array set param $params
# Append the file if there exist a filename to use. Otherwise do not append
if {[exists_and_not_null param(name)]} {
if {([info exists param(name)] && $param(name) ne "")} {
set filename $param(name)
# Determine the content_type
set content_type [mime::getproperty $part content]
if {$content_type eq "application/octet-stream"} {
set content_type [ns_guesstype $filename]
}
}
lappend files [list $content_type $encoding $filename $content]
}
}
......@@ -280,7 +256,6 @@ namespace eval acs_mail_lite {
#release the message
mime::finalize $mime -subordinates all
}
ad_proc -public autoreply_p {
......
www/restore-bounce.adp
View file @ 0fd18113
<master>
<property name="title">@page_title;noquote@</property>
<property name="context">@context;noquote@</property>
<property name="doc(title)">@page_title;literal@</property>
<property name="context">@context;literal@</property>
<p>#acs-mail-lite.Bounce_disabled#</p>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment