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 all

XQL Not present:

PostgreSQL, Oracle

Generic XQL file:

packages/acs-mail-lite/tcl/legacy-inbound-procs.xql