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 send immediately with the option to pass in a list of file_ids as well as specify an html_body and a mime_type. It also supports multiple "TO" recipients as well as CC and BCC recipients. Runs entirely off MIME and SMTP to achieve this.

Switches:
-valid_email_p (defaults to "0") (optional)
-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 send 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 send as attachments.
-delete_filesystem_files_p (defaults to "0") (optional)
Decides if we want files specified by the 'file' parameter to be deleted once sent.
-mime_type (defaults to "text/plain") (optional)
MIME Type of the mail to send out. Can be "text/plain", "text/html".
-no_callback_p (defaults to "0") (optional)
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 (defaults to "0") (optional)
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):
%3 acs_mail_lite::send acs_mail_lite::send (public) acs_mail_lite::send_immediately acs_mail_lite::send_immediately acs_mail_lite::send->acs_mail_lite::send_immediately acs_mail_lite::sweeper acs_mail_lite::sweeper (private) acs_mail_lite::sweeper->acs_mail_lite::send_immediately

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 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]
            }
        }

        # 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, includeing 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

[ hide source ] | [ make this the default ]
Show another procedure: