acs_mail_lite::parse_email (private)
acs_mail_lite::parse_email -file file -array array
Defined in packages/acs-mail-lite/tcl/legacy-inbound-procs.tcl
An email is split into several parts: headers, bodies and files lists and all headers directly. The headers consists of a list with header names as keys and their corresponding values. All keys are lowercase. The bodies consists of a list with two elements: content-type and content. The files consists of a list with three elements: content-type, filename and content. The array with all the above data is upvared to the caller environment. Important headers are: -message-id (a unique id for the email, is different for each email except it was bounced from a mailer daemon) -subject -from -to Others possible headers: -date -received -references (this references the original message id if the email is a reply) -in-reply-to (this references the original message id if the email is a reply) -return-path (this is used for mailer daemons to bounce emails back like bounce-user_id-signature-package_id@service0.com) Optional application specific stuff only exist in special cases: X-Mozilla-Status X-Virus-Scanned X-Mozilla-Status2 X-UIDL X-Account-Key X-Sasl-enc You can therefore get a value for a header either through iterating the headers list or simply by calling i.e. "set message_id $email(message-id)". Note: We assume "application/octet-stream" for all attachments and "base64" for as transfer encoding for all files. Note: tcllib required - mime, base64
- Switches:
- -file (required)
- -array (required)
- Author:
- Nima Mazloumi <nima.mazloumi@gmx.de>
- Created:
- 2005-07-15
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Source code: upvar $array email #prepare the message if {[catch {set mime [mime::initialize -file $file]} errormsg]} { ns_log error "Email could not be delivered for file $file" set stream [open $file] set content [read $stream] close $stream ns_log error $content file delete -- $file return } #get the content type set content [mime::getproperty $mime content] #get all available headers set keys [mime::getheader $mime -names] set headers [list] # create both the headers array and all headers directly for the email array foreach header $keys { set value [mime::getheader $mime $header] set email([string tolower $header]) $value lappend headers [list $header $value] } set email(headers) $headers #check for multipart, otherwise we only have one part if { [string first "multipart" $content] != -1 } { set parts [mime::getproperty $mime parts] } else { set parts [list $mime] } # travers the tree and extract parts into a flat list set all_parts [list] foreach part $parts { if {[mime::getproperty $part content] eq "multipart/alternative"} { foreach child_part [mime::getproperty $part parts] { lappend all_parts $child_part } } else { lappend all_parts $part } } set bodies [list] set files [list] #now extract all parts (bodies/files) and fill the email array foreach part $all_parts { # 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"} { 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]] } } } else { set encoding [mime::getproperty $part encoding] set body [mime::getbody $part -decode] set content $body set params [mime::getproperty $part params] array set param $params # Append the file if there exist a filename to use. Otherwise do not append 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] } } } set email(bodies) $bodies set email(files) $files #release the message mime::finalize $mime -subordinates allXQL Not present: PostgreSQL, Oracle Generic XQL file: packages/acs-mail-lite/tcl/legacy-inbound-procs.xql