acs_mail_lite::send_immediately (private)

 acs_mail_lite::send_immediately [ -valid_email_p valid_email_p ] \
    -to_addr to_addr [ -cc_addr cc_addr ] [ -bcc_addr bcc_addr ] \
    -from_addr from_addr [ -reply_to reply_to ] [ -subject subject ] \
    -body body [ -package_id package_id ] [ -file_ids file_ids ] \
    [ -filesystem_files filesystem_files ] \
    [ -delete_filesystem_files_p delete_filesystem_files_p ] \
    [ -mime_type mime_type ] [ -no_callback_p no_callback_p ] \
    [ -extraheaders extraheaders ] [ -use_sender_p use_sender_p ] \
    [ -object_id object_id ] \
    [ -force_delivery_mode force_delivery_mode ]

Defined in packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl

Prepare an email to be sent immediately. Various email attributes can be specified, such as subject, body, senders, recipients, attachments and so on. The proc relies on MIME and SMTP.

Switches:

-valid_email_p (optional, defaults to "0")

-to_addr (required)

List of e-mail addresses to send this mail to.

-cc_addr (optional)

List of CC Users e-mail addresses to send this mail to.

-bcc_addr (optional)

List of CC Users e-mail addresses to send this mail to.

-from_addr (required)

E-Mail address of the sender.

-reply_to (optional)

E-Mail address to which replies should go. Defaults to from_addr

-subject (optional)

of the email

-body (required)

Text body of the email

-package_id (optional)

Package ID of the sending package

-file_ids (optional)

List of file ids (items or revisions) to be sent as attachments. This will only work with files stored in the file-storage.

-filesystem_files (optional)

List of regular files on the filesystem to be sent as attachments.

-delete_filesystem_files_p (optional, defaults to "0")

Decides if we want files specified by the 'file' parameter to be deleted once sent.

-mime_type (optional, defaults to "text/plain")

MIME Type of the mail to send out. Can be "text/plain", "text/html".

-no_callback_p (optional, defaults to "0")

Indicates if callback should be executed or not. If you don't provide it it will execute callbacks.

-extraheaders (optional)

List of keywords and their values passed in for headers. Interesting ones are: "Precedence: list" to disable autoreplies and mark this as a list message. This is as list of lists !!

-use_sender_p (optional, defaults to "0")

Boolean indicating that from_addr should be used regardless of fixed-sender parameter

-object_id (optional)

Object id that caused this email to be sent

-force_delivery_mode (optional)

Force the specified delivery mode for this single call

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

Testcases:

No testcase defined.

Source code:

        set mail_package_id [get_package_id]
        if {$package_id eq ""} {
            set package_id $mail_package_id
        }

        # Decide which sender to use
        set fixed_sender [parameter::get  -parameter "FixedSenderEmail"  -package_id $mail_package_id]

        if { $fixed_sender ne "" && !$use_sender_p} {
            set from_addr $fixed_sender
        }

        set from_addr [encode_email_address $from_addr]
        set to_addr [lmap email $to_addr {encode_email_address $email}]

        # Set the Reply-To
        if {$reply_to eq ""} {
            set reply_to $from_addr
        }

        # Get any associated data indicating need to sign message-id

        # Recipients might be specified as "DisplayName <email>". This
        # format is valid for the "To:" email header, but not for the
        # "RCPT TO", hence we strip the eventually-present display
        # name from the latter.
        set to_addr_header $to_addr
        set to_addr [list]
        foreach addr $to_addr_header {
            if {[regexp {^.* <(.*)>$} $addr _ email]} {
                lappend to_addr $email
            } else {
                lappend to_addr $addr
            }
        }

        # associate a user_id
        set rcpt_id 0
        if { [llength $to_addr] == 1 } {
            set rcpt_id [party::get_by_email -email $to_addr]
            if {$rcpt_id eq ""} {
                set rcpt_id 0
            }
        }


        # Set the message_id
        # message-id gets signed if parameter defaults not passed
        set message_id [acs_mail_lite::unique_id_create  -object_id $object_id  -package_id $package_id  -party_id $rcpt_id]


        # Set originator header
        set originator_email [parameter::get  -parameter "OriginatorEmail"  -package_id $mail_package_id]

        # Decision based firstly on parameter,
        # and then on other values that most likely could be substituted
        # with initial choice, and while meeting definition
        # of originator header according to RFC 2822 section 3.6.2
        # https://tools.ietf.org/html/rfc2822#section-3.6.2
        # A value must be provided.
        switch -exact -- $originator_email {
            fixed_sender {
                if { $fixed_sender ne "" } {
                    set originator $fixed_sender
                } elseif { $from_addr ne "" } {
                    set originator $from_addr
                } else {
                    set originator $message_id
                }
            }
            from_address {
                if { $from_addr ne "" } {
                    set originator $from_addr
                } elseif { $fixed_sender ne "" } {
                    set originator $fixed_sender
                } else {
                    set originator $message_id
                }
            }
            message_id {
                set originator $message_id
            }
            reply_to {
                if { $reply_to ne "" } {
                    set originator $reply_to
                } elseif { $from_addr ne "" } {
                    set originator $from_addr
                } else {
                    set originator $message_id
                }
            }
            bounce_address -
            default {
                # Build the originator address to be used as envelope sender
                # and originator etc.
                set originator [bounce_address -user_id $rcpt_id  -package_id $package_id  -message_id $message_id]
            }
        }

        ns_log notice "ORIGINATOR <$originator>"
        # Set the date
        set message_date [acs_mail_lite::utils::build_date]

        # Build the message body
        set tokens [acs_mail_lite::utils::build_body  -mime_type $mime_type -- $body]

        # Add attachments if any
        # ...from file-storage
        if {$file_ids ne ""} {
            set item_ids [list]

            # Check if we are dealing with revisions or items.
            foreach file_id $file_ids {
                set item_id [content::revision::item_id -revision_id $file_id]
                if {$item_id eq ""} {
                    lappend item_ids $file_id
                } else {
                    lappend item_ids $item_id
                }
            }

            db_foreach get_file_info {} {
                lappend tokens [mime::initialize  -param [list name [ns_quotehtml $title]]  -header [list Content-Disposition "attachment; filename=\"$name\""]  -header [list Content-Description $title]  -canonical $mime_type  -file [content::revision::get_cr_file_path -revision_id $revision_id]]
            }
        }

        # ...from filesystem
        if {$filesystem_files ne ""} {
            # get root of folders into which files are allowed to be sent
            set filesystem_attachments_root [parameter::get  -parameter "FilesystemAttachmentsRoot"  -package_id $mail_package_id  -default ""]
            if {$filesystem_attachments_root eq ""} {
                # on a unix system this could be '/tmp'
                set filesystem_attachments_root [ad_tmpdir]
            }
            foreach f $filesystem_files {
                # make the filename absolute
                if {[file pathtype $f] ne "absolute"} {
                    set f [file join [pwd] $f]
                }
                if {![file exists $f]} {
                    ns_log Error "acs-mail-lite::send: Could not send mail: file '$f' does not exist"
                    return
                }
                if {[string first $filesystem_attachments_root $f] != 0} {
                    ns_log Error "acs-mail-lite::send: Could not send mail: file '$f' is outside the allowed root folder for attachments '$filesystem_attachments_root'"
                    return
                }
                set name [file tail $f]
                set mime_type [cr_filename_to_mime_type $name]
                lappend tokens [mime::initialize  -param [list name $name]  -header [list Content-Disposition "attachment; filename=\"$name\""]  -header [list Content-Description $name]  -canonical $mime_type  -file $f]
            }
        }

        if {$file_ids ne "" || $filesystem_files ne ""} {
            set tokens [mime::initialize -canonical "multipart/mixed" -parts $tokens]
        }

        ### Add the headers

        mime::setheader $tokens "message-id" $message_id
        mime::setheader $tokens date $message_date

        # Set the subject
        if { $subject ne "" } {
            set encoded_subject [acs_mail_lite::utils::build_subject -- $subject]
            mime::setheader $tokens Subject $encoded_subject
        }

        # Add extra headers
        foreach header $extraheaders {
            mime::setheader $tokens [lindex $header 0] [lindex $header 1]
        }

        # Get the delivery parameters, including SMTP
        set deliveryDict [get_delivery_parameters]

        # Rollout support
        set default_send_mode smtp

        if {$force_delivery_mode ne ""} {
            set delivery_mode $force_delivery_mode
        } else {
            set delivery_mode [dict get $deliveryDict EmailDeliveryMode]
        }

        foreach w $delivery_mode {
            if {$w ni {smtp nssmtpd default log redirect ignore}} {
                ns_log warning "unexpected entry '$w' in parameter EmailDeliveryMode (ignored)"
            }
        }

        if {"nssmtpd" in $delivery_mode} {
            #
            # Filter the word "nssmtpd" from the EmailDeliveryMode and
            # try to use "nssmtpd" as default_send mode
            #
            if {[llength $delivery_mode] > 1} {
                # Filter "nssmtpd" from the list
                set delivery_mode [lmap m $delivery_mode {
                    if {$m eq "nssmtpd"} continue
                    set m
                }]
            }
            #
            # "ns_smtpd" can be used, when it is available and no
            # password mode is specified.
            #
            if { [namespace which ns_smtpd] eq ""
                 || [dict get $deliveryDict SMTPPassword] ne ""
                 || [dict get $deliveryDict SMTPUser] ne ""
             } {
                ns_log warning "configured 'nssmtp' as EmailDeliveryMode but it can't be used."
             } else {
                 set default_send_mode nssmtpd
             }
        }

        switch -- $delivery_mode {
            log {
                set send_mode "log"
                set notice "logging email instead of sending"
            }
            filter {
                set send_mode $default_send_mode
                set allowed_addr [parameter::get  -package_id $mail_package_id  -parameter EmailAllow]

                foreach recipient [concat $to_addr $cc_addr $bcc_addr] {

                    # if any of the recipient is not in the allowed list
                    # email message has to be sent to the log instead

                    if {$recipient ni $allowed_addr} {
                        set send_mode "log"
                        set notice "logging email because one of the recipient ($recipient) is not in the EmailAllow list"
                        break
                    }
                }

            }
            redirect {
                set send_mode $default_send_mode

                set redirect_to [parameter::get  -package_id $mail_package_id  -parameter EmailRedirectTo]
                if {$redirect_to eq ""} {
                    ns_log warning "acs-mail-lite: redirect mode activated but no value for EmailRedirectTo provided"
                    set send_mode ignore
                } else {
                    set to_addr $redirect_to
                    set to_addr_header $redirect_to

                    # Since we have to redirect to a list of addresses
                    # we need to remove the CC and BCC
                    set cc_addr ""
                    set bcc_addr ""
                }
            }
            default {
                set send_mode $default_send_mode
            }
        }

        # Prepare the headers list of recipients
        set headers_list [list [list From $from_addr]  [list Reply-To $reply_to]  [list To [join $to_addr_header ","]]]

        if { $cc_addr ne "" } {
            lappend headers_list [list CC [join $cc_addr ","]]
        }

        if { $bcc_addr ne ""} {

            # BCC implementation in tcllib 1.8 to 1.11 is awkward. It
            # sends the blind copy as an attachment, changes the From
            # header replacing it with the originator, etc. So we use
            # DCC instead which behaves as one would expect Bcc to
            # behave.

            lappend headers_list [list DCC [join $bcc_addr ","]]
        }

        set errorMsg ""
        set status ok
        
        ns_log notice "sending mail to $to_addr with send_mode '$send_mode'"
        if {$send_mode eq "nssmtpd"} {

            foreach header $headers_list {
                mime::setheader $tokens [lindex $header 0] [lindex $header 1]
            }
            set fullMailMessage [mime::buildmessage $tokens]

            #
            # Call "ns_smtpd send" from the NaviServer nssmtpd module.
            # When the last two arguments are not provided, the
            # command uses host and port from the configuration
            # section of the nssmtpd module.
            #
            try {
                ns_smtpd send $originator $to_addr fullMailMessage  [dict get $deliveryDict SMTPHost]  [dict get $deliveryDict SMTPPort]
            } on error {errorMsg} {
                set status error
            }

        } elseif { $send_mode eq "log" } {

            # Add recipients to headers
            foreach header $headers_list {
                mime::setheader $tokens [lindex $header 0] [lindex $header 1]
            }

            # Retrieve the email message as a string
            set packaged [mime::buildmessage $tokens]

            # Send the email message to the log
            ns_log Notice "acs-mail-lite::send: $notice\n\n**********\n Envelope sender: $originator\n\n$packaged\n**********"

        } elseif {$send_mode eq "smtp"} {

            ad_try {
                acs_mail_lite::smtp -multi_token $tokens  -headers $headers_list  -originator $originator  -delivery_dict $deliveryDict
            } on error {errorMsg} {
                set status error
            }

        } else {
            #
            # Ignoring sending message
            #
            ns_log warning "acs-mail-lite::send: ignore sending message to $to_addr"
        }

        #
        # Close all mime tokens
        #
        mime::finalize $tokens -subordinates all


        if { !$no_callback_p } {
            callback acs_mail_lite::send  -package_id $package_id  -message_id $message_id  -from_addr $from_addr  -to_addr $to_addr  -body $body  -mime_type $mime_type  -subject $subject  -cc_addr $cc_addr  -bcc_addr $bcc_addr  -file_ids $file_ids  -filesystem_files $filesystem_files  -delete_filesystem_files_p $delete_filesystem_files_p  -object_id $object_id  -status $status  -errorMsg $errorMsg
        }

        # Attachment files can now be deleted, if so required.
        # I leave this as the last thing to do, because callbacks
        # could need to look at files for their own purposes.
        if {[string is true $delete_filesystem_files_p]} {
            foreach f $filesystem_files {
            file delete -- $f
            }
        }
        if {$status ne "ok"} {
            error $errorMsg
        }

Generic XQL file:

<fullquery name="acs_mail_lite::send_immediately.get_file_info">
    <querytext>
      select r.mime_type, r.title, r.revision_id, i.name
      from cr_revisions r, cr_items i
      where r.revision_id = i.latest_revision
        and i.item_id in ([join $item_ids ","])
    </querytext>
</fullquery>

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

PostgreSQL XQL file:

packages/acs-mail-lite/tcl/acs-mail-lite-procs-postgresql.xql

Oracle XQL file:

packages/acs-mail-lite/tcl/acs-mail-lite-procs-oracle.xql