- Comitting OpenACS 5.9

sql/oracle/acs-mail-lite-create.sql

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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/bounce-procs.tcl

@@ -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

@@ -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

 <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>