Commit 4adecd51 authored by Frank Bergmann's avatar Frank Bergmann

-- added support for "multipart/mixed" mails

   currently ignores "text/html" tokens
parent aed02f9a
...@@ -164,6 +164,7 @@ namespace eval acs_mail_lite { ...@@ -164,6 +164,7 @@ namespace eval acs_mail_lite {
@creation-date 2005-07-15 @creation-date 2005-07-15
} { } {
upvar $array email upvar $array email
#prepare the message #prepare the message
...@@ -176,10 +177,11 @@ namespace eval acs_mail_lite { ...@@ -176,10 +177,11 @@ namespace eval acs_mail_lite {
ns_unlink $file ns_unlink $file
return return
} }
#get the content type #get the content type
set content [mime::getproperty $mime content] set content [mime::getproperty $mime content]
ns_log NOTICE "incoming-mail-procs::parse_email: Content: $content"
#get all available headers #get all available headers
set keys [mime::getheader $mime -names] set keys [mime::getheader $mime -names]
...@@ -196,19 +198,25 @@ namespace eval acs_mail_lite { ...@@ -196,19 +198,25 @@ namespace eval acs_mail_lite {
#check for multipart, otherwise we only have one part #check for multipart, otherwise we only have one part
if { [string first "multipart" $content] != -1 } { if { [string first "multipart" $content] != -1 } {
# ns_log NOTICE "incoming-mail-procs::parse_email: Found multipart"
set parts [mime::getproperty $mime parts] set parts [mime::getproperty $mime parts]
} else { } else {
# ns_log NOTICE "incoming-mail-procs::parse_email: Multipart not found"
set parts [list $mime] set parts [list $mime]
} }
# travers the tree and extract parts into a flat list # travers the tree and extract parts into a flat list
set all_parts [list] set all_parts [list]
foreach part $parts { foreach part $parts {
if {[mime::getproperty $part content] eq "multipart/alternative"} { 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" } {
foreach child_part [mime::getproperty $part parts] { 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 lappend all_parts $child_part
} }
} else { } else {
# ns_log NOTICE "incoming-mail-procs::parse_email: Adding to all_parts (main): $part "
lappend all_parts $part lappend all_parts $part
} }
} }
...@@ -216,24 +224,41 @@ namespace eval acs_mail_lite { ...@@ -216,24 +224,41 @@ namespace eval acs_mail_lite {
set bodies [list] set bodies [list]
set files [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 #now extract all parts (bodies/files) and fill the email array
foreach part $all_parts { foreach part $all_parts {
# ns_log NOTICE "incoming-mail-procs::parse_email: Now working on part: $part"
# Attachments have a "Content-disposition" part # Attachments have a "Content-disposition" part
# Therefore we filter out if it is an attachment here # Therefore we filter out if it is an attachment here
if {[catch {mime::getheader $part Content-disposition}] || [mime::getheader $part Content-disposition] eq "inline"} { if {[catch {mime::getheader $part Content-disposition}] || [mime::getheader $part Content-disposition] eq "inline"} {
switch [mime::getproperty $part content] { # ns_log NOTICE "incoming-mail-procs::parse_email: Entering Bodies .... "
"text/plain" { if [catch {
lappend bodies [list "text/plain" [mime::getbody $part]] switch [mime::getproperty $part content] {
} "text/plain" {
"text/html" { lappend bodies [list "text/plain" [mime::getbody $part]]
lappend bodies [list "text/html" [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 { } else {
# ns_log NOTICE "incoming-mail-procs::parse_email: Entering Attachments .... "
set encoding [mime::getproperty $part encoding] set encoding [mime::getproperty $part encoding]
set body [mime::getbody $part -decode] set body [mime::getbody $part -decode]
set content $body set content $body
set params [mime::getproperty $part params] set params [mime::getproperty $part params]
# ns_log NOTICE "incoming-mail-procs::parse_email: Params: $params"
array set param $params array set param $params
# Append the file if there exist a filename to use. Otherwise do not append # Append the file if there exist a filename to use. Otherwise do not append
...@@ -244,8 +269,7 @@ namespace eval acs_mail_lite { ...@@ -244,8 +269,7 @@ namespace eval acs_mail_lite {
set content_type [mime::getproperty $part content] set content_type [mime::getproperty $part content]
if {$content_type eq "application/octet-stream"} { if {$content_type eq "application/octet-stream"} {
set content_type [ns_guesstype $filename] set content_type [ns_guesstype $filename]
} }
lappend files [list $content_type $encoding $filename $content] lappend files [list $content_type $encoding $filename $content]
} }
} }
...@@ -256,6 +280,7 @@ namespace eval acs_mail_lite { ...@@ -256,6 +280,7 @@ namespace eval acs_mail_lite {
#release the message #release the message
mime::finalize $mime -subordinates all mime::finalize $mime -subordinates all
} }
ad_proc -public autoreply_p { ad_proc -public autoreply_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