notification::email::load_qmail_mail_queue (private)

 notification::email::load_qmail_mail_queue -queue_dir queue_dir

Defined in packages/notifications/tcl/notification-email-procs.tcl

Scans qmail incoming email queue and queues up messages using acs-mail.

Switches:

-queue_dir (required)

The location of the qmail mail queue in the file-system.

Authors:

ben@openforce.net

dan.wickstrom@openforce.net

Created:

22 Sept, 2001

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

        ns_log debug "load_qmail_mail_queue: checking $queue_dir/new/ for incoming mail"

        if {[catch {
            set messages [glob "$queue_dir/new/*"]
        } errmsg]} {
            if {[string match "no files matched glob pattern*"  $errmsg ]} {
                ns_log Debug "load_qmail_mail_queue: queue dir = $queue_dir/new/*, no messages"
            } else {
                ns_log Error "load_qmail_mail_queue: queue dir = $queue_dir/new/ error $errmsg"
            }
            return {}
        }

        set list_of_reply_ids [list]
        set new_messages_p 0

        foreach msg $messages {
            ns_log Debug "load_qmail_mail_queue: opening file: $msg"
            if {[catch {set f [open $msg r]} errmsg]} {
                # spit out an error message for failure to open and continue to next message
                ns_log Warning "load_qmail_mail_queue: error opening file $errmsg"
                continue
            }
            set orig_file [read $f]
            close $f
            set file [split $orig_file "\n"]

            set new_messages 1
            set end_of_headers_p 0
            set i 0
            set line [lindex $file $i]
            set headers [list]
            set orig_headers ""

            # walk through the headers and extract each one
            set is_auto_reply_p 0
            while {$line ne ""} {
                set next_line [lindex $file $i+1]
                if {[regexp {^[ ]*$} $next_line match] && $i > 0} {
                    set end_of_headers_p 1
                }
                set multiline_header_p 0
                if {[regexp {^([^:]+):[ ]+(.+)$} $line match name value]} {
                    # join headers that span more than one line (e.g. Received)
                    if { ![regexp {^([^:]+):[ ]+(.+)$} $next_line match] && !$end_of_headers_p} {
                        set multiline_header_p 1
                    } else {
                        # we only want messages a person typed in themselves - nothing
                        # from any sort of auto-responder.
                        if { [string compare -nocase $name "Auto-Submitted"] == 0 } {
                            set is_auto_reply_p 1
                            break
                        } elseif { [string compare -nocase $name "Subject"] == 0 && [string first "Out of Office AutoReply:" $value] == 0 } {
                            # added for BP
                            set is_auto_reply_p 1
                            break
                        } else {
                            lappend headers [string tolower $name] $value
                            append orig_headers "$line\n"
                        }
                    }

                    if {$end_of_headers_p} {
                        incr i
                        break
                    }
                } else {
                    # The headers and the body are delimited by a null line as specified by RFC822
                    if {[regexp {^[ ]*$} $line match]} {
                        incr i
                        break
                    }
                }
                incr i
                if { $multiline_header_p } {
                    append line [lindex $file $i]
                } else {
                    set line [lindex $file $i]
                }
            }


            # a break above just exited the while loop;  now we need to skip
            # the rest of the foreach as well
            if { $is_auto_reply_p } {
                ns_log Debug "load_qmail_mail_queue: message $msg is from an auto-responder, skipping"
                if {[catch {file delete -- $msg} errmsg]} {
                    ns_log Warning "load_qmail_mail_queue: couldn't remove message $msg:  $errmsg"
                }
                continue
            }

            set body [ad_parse_incoming_email $orig_file]



            # okay now we have a list of headers and the body, let's
            # put it into notifications stuff
            array set email_headers $headers


            if {[catch {set from $email_headers(from)}]} {
                set from ""
            }
            if {[catch {set to $email_headers(to)}]} {
                set to ""
            }

            set from [parse_email_address $from]
            set to [parse_email_address $to]

            # Find the from user
            set from_user [party::get_by_email -email $from]

            # We don't accept empty users for now
            if {$from_user eq ""} {
                ns_log debug "load_qmail_mail_queue: no user for from address: $from, to: $to. bouncing message."
                # bounce message with an informative error.
                bounce_mail_message  -to_addr $email_headers(from)  -from_addr $email_headers(to)  -body $body   -message_headers $orig_headers  -reason "Invalid sender.  You must be a member of the site and\nyour From address must match your registered address."

                if {[catch {file delete -- $msg} errmsg]} {
                    ns_log Warning "load_qmail_mail_queue: couldn't remove message $msg: $errmsg"
                }
                continue
            }

            set to_stuff [parse_reply_address -reply_address $to]
            # We don't accept a bad incoming email address
            if {$to_stuff eq ""} {
                ns_log debug "load_qmail_mail_queue: bad to address $to from $from. bouncing message."

                # bounce message here
                bounce_mail_message -to_addr $email_headers(from)  -from_addr $email_headers(to)  -body $body  -message_headers $orig_headers  -reason "Invalid To Address"

                if {[catch {file delete -- $msg} errmsg]} {
                    ns_log Warning "load_qmail_mail_queue: couldn't remove message file $msg: $errmsg"
                }
                continue
            }

            lassign $to_stuff object_id type_id
            set to_addr $to

            db_transaction {
                set reply_id [notification::reply::new  -object_id $object_id  -type_id $type_id  -from_user $from_user  -subject $email_headers(subject)  -content $body]
                set headers $orig_headers
                db_dml holdinsert {} -clobs [list $to_addr $headers $body]

                if {[catch {file delete -- $msg} errmsg]} {
                ns_log Error "load_qmail_mail_queue: unable to delete queued message $msg: $errmsg"
            }

                lappend list_of_reply_ids $reply_id
            } on_error {
                ns_log Error "load_qmail_mail_queue: error inserting incoming email into the queue: $errmsg"
            }
        }

        return $list_of_reply_ids

XQL Not present:

PostgreSQL

Generic XQL file:

<fullquery name="notification::email::load_qmail_mail_queue.holdinsert">
    <querytext>
        insert into notification_email_hold
        (reply_id,to_addr,headers,body)
        values
        (:reply_id,:to_addr,:headers,:body)
      </querytext>
</fullquery>

packages/notifications/tcl/notification-email-procs.xql

Oracle XQL file:

<fullquery name="notification::email::load_qmail_mail_queue.holdinsert">
    <querytext>
        insert into notification_email_hold
        (reply_id,to_addr,headers,body)
        values
        (:reply_id,empty_clob(),empty_clob(),empty_clob())
       returning to_addr, headers, body into :1, :2, :3
      </querytext>
</fullquery>

packages/notifications/tcl/notification-email-procs-oracle.xql