Index: openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl,v
diff -u -r1.108 -r1.109
--- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl	21 Jun 2018 15:45:03 -0000	1.108
+++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl	3 Sep 2024 15:37:33 -0000	1.109
@@ -5,16 +5,15 @@
     @author Eric Lorenzo (eric@openforce.net)
     @creation-date 22 March 2002
     @cvs-id $Id$
-
 }
 
 package require mime 1.4
 package require smtp 1.4
-package require base64 2.3.1
+# package require base64 2.3.1
 
 namespace eval acs_mail_lite {
 
-    ad_proc -public get_package_id {} {
+    ad_proc -private get_package_id {} {
         @return package_id of this package
     } {
         return [apm_package_id_from_key acs-mail-lite]
@@ -33,20 +32,28 @@
         @return apm-parameter value of this package
         @see parameter::get
     } {
-        return [parameter::get -package_id [get_package_id] -parameter $name -default $default]
+        return [parameter::get \
+                    -package_id [get_package_id] \
+                    -parameter $name \
+                    -default $default]
     }
 
     ad_proc -private mail_dir {} {
         @return incoming mail directory to be scanned for bounces
     } {
-        return [parameter::get -package_id [get_package_id] -parameter "BounceMailDir" -default ""]
+        return [parameter::get \
+                    -package_id [get_package_id] \
+                    -parameter "BounceMailDir" \
+                    -default ""]
     }
 
     #---------------------------------------
-    ad_proc -public parse_email_address {
+    ad_proc -private parse_email_address {
         -email:required
     } {
-        Extracts the email address out of a mail address (like Joe User <joe@user.com>)
+        Extracts the email address out of a mail address
+        (like Joe User &lt;joe@user.com&gt;)
+
         @option email mail address to be parsed
         @return only the email address part of the mail address
     } {
@@ -73,7 +80,7 @@
 
 
     #---------------------------------------
-    ad_proc -public generate_message_id {
+    ad_proc -private generate_message_id {
     } {
         Generate an id suitable as a Message-Id: header for an email.
         @return valid message-id for mail header
@@ -85,37 +92,35 @@
     }
 
     #---------------------------------------
-    ad_proc -public valid_signature {
+    ad_proc -private valid_signature {
         -signature:required
         -message_id:required
     } {
-        Validates if provided signature matches message_id
-        @option signature signature to be checked
-        @option msg message-id that the signature should be checked against
+        Validates if provided signature syntactically matches message_id
+        as generated by OpenACS and equals to the hash of the provided signature.
+        GN: not sure, why both is checked.
+
+        @param signature signature to be checked
+        @param message_id message ID that the signature should be checked against
         @return boolean 0 or 1
     } {
-        if {![regexp "(<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)" $message_id match id] || $signature ne [ns_sha1 $id] } {
+        if {![regexp "(<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)" $message_id match id]
+            || $signature ne [ns_sha1 $id]
+        } {
             # either couldn't find message-id or signature doesn't match
             return 0
         }
         return 1
     }
 
     #---------------------------------------
-    ad_proc -private smtp {
-        -multi_token:required
-        -headers:required
-        -originator:required
-    } {
-        Send messages via SMTP
+    ad_proc -private get_delivery_parameters {} {
+        Get the SMTP Parameters and return these as a dict.
 
-        @param multi_token Multi Token generated which is passed directly to smtp::sendmessage
-        @param headers List of list of header key-value pairs like {{from malte@cognovis.de} {to malte@cognovis.de}}
+        @return dict with keys identical to the package parameters
     } {
+        set mail_package_id [get_package_id]
 
-        set mail_package_id [apm_package_id_from_key "acs-mail-lite"]
-
-        # Get the SMTP Parameters
         set smtpHost [parameter::get -parameter "SMTPHost" \
                       -package_id $mail_package_id \
                       -default [ns_config ns/parameters mailhost]]
@@ -126,43 +131,83 @@
         set timeout [parameter::get -parameter "SMTPTimeout" \
                          -package_id $mail_package_id \
                          -default  [ns_config ns/parameters smtptimeout]]
-
         if {$timeout eq ""} {
             set timeout 60
         }
 
-        set smtpport [parameter::get -parameter "SMTPPort" \
+        set smtpPort [parameter::get -parameter "SMTPPort" \
                           -package_id $mail_package_id \
                           -default 25]
 
-        set smtpuser [parameter::get -parameter "SMTPUser" \
+        set smtpUser [parameter::get -parameter "SMTPUser" \
                           -package_id $mail_package_id]
 
-        set smtppassword [parameter::get -parameter "SMTPPassword" \
+        set smtpPassword [parameter::get -parameter "SMTPPassword" \
                               -package_id $mail_package_id]
 
+        set deliveryMode [parameter::get \
+                               -package_id $mail_package_id \
+                               -parameter EmailDeliveryMode \
+                               -default default]
+        return [list \
+                    SMTPHost $smtpHost \
+                    SMTPTimeout $timeout \
+                    SMTPPort $smtpPort \
+                    SMTPUser $smtpUser \
+                    SMTPPassword $smtpPassword \
+                    EmailDeliveryMode $deliveryMode]
+    }
+
+
+    #---------------------------------------
+    ad_proc -private smtp {
+        -multi_token:required
+        -headers:required
+        -originator:required
+        -delivery_dict:required
+    } {
+        Send messages via SMTP
+
+        @param multi_token Multi Token generated which is passed
+               directly to smtp::sendmessage
+
+        @param headers List of list of header key-value pairs like
+               {{from malte@cognovis.de} {to malte@cognovis.de}}
+
+        @param delivery_dict dictionary of delivery parameters
+               including the SMTP* configuration parameters
+
+    } {
+
         # Consider adding code here to
         # set orignator to acs-mail-lite parameter FixedSenderEmail
         # if FixedSenderEmail is not empty,
         # so as to be consistent for all cases calling this proc.
 
+        ns_log notice "SMTP call sendmessage <$originator>"
         set cmd [list smtp::sendmessage $multi_token -originator $originator]
+        ns_log notice "SMTP call sendmessage <$originator> DONE"
         foreach header $headers {
             lappend cmd -header $header
         }
-        lappend cmd -servers $smtpHost -ports $smtpport
+        lappend cmd \
+            -servers [dict get $delivery_dict SMTPHost] \
+            -ports [dict get $delivery_dict SMTPPort]
 
         #
         # Request authentication only, when user AND password are
         # specified. If only one of these is specified, issue a
         # warning and ignore the parameter.
         #
-        if {$smtpuser ne "" && $smtppassword ne ""} {
-            lappend cmd -username $smtpuser -password $smtppassword
-        } elseif {$smtpuser ne ""|| $smtppassword ne ""} {
+        set smtpUser [dict get $delivery_dict SMTPUser]
+        set smtpPassword [dict get $delivery_dict SMTPPassword]
+        if {$smtpUser ne "" && $smtpPassword ne "" } {
+            lappend cmd -username $smtpUser -password $smtpPassword
+        } elseif {$smtpUser ne ""|| $smtpPassword ne ""} {
             ns_log warning "acs-mail-lite::smtp: invalid parameter combination;\
                 when SMTPUser is specified, SMTPPassword has to be provided as well and vice versa"
         }
+        ns_log notice "SMTP call <$cmd>"
 
         ns_log Debug "send cmd: $cmd"
         if {[catch $cmd errorMsg]} {
@@ -183,13 +228,13 @@
         for the mail procedures
     } {
         if {[catch {array set address_array $addresses}]
-            || [lsort [array names address_array] ne [list email name user_id]
-            } {
-
-            # either user just passed a normal address-list or
+            || [lsort [array names address_array]] ne [list email name user_id]
+        } {
+            #
+            # Either user just passed a normal address-list or
             # user passed an array, but forgot to provide user_ids
             # or user_names, so we have to get this data from the db
-
+            #
             if {![info exists address_array(email)]} {
                 # so user passed on a normal address-list
                 set address_array(email) $addresses
@@ -205,7 +250,14 @@
             # now get the user_names and user_ids
             foreach email $address_list {
                 set email [string tolower $email]
-                if {[db_0or1row get_user_name_and_id ""]} {
+                if {[db_0or1row get_user_name_and_id {
+                    select person_id as user_id, first_names || ' ' || last_name as user_name
+                    from parties, persons
+                    where email = :email
+                      and party_id = person_id
+                     order by party_id desc
+                    fetch first 1 rows only
+                }]} {
                     lappend address_array(email) $email
                     lappend address_array(name) $user_name
                     lappend address_array(user_id) $user_id
@@ -241,12 +293,13 @@
         {-object_id ""}
     } {
 
-        Prepare an email to be send 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.
+        Prepare an email to be sent. Various email attributes can be
+        specified, such as subject, body, senders, recipients,
+        attachments and so on. The proc relies on MIME and SMTP.
 
-        @param send_immediately The email is send immediately and not stored in the acs_mail_lite_queue
+        @param send_immediately The email is send immediately and not
+               stored in the acs_mail_lite_queue
+
         @param to_addr List of e-mail addresses to send this mail to.
 
         @param from_addr E-Mail address of the sender.
@@ -261,29 +314,47 @@
 
         @param package_id Package ID of the sending package
 
-        @param file_ids List of file ids (items or revisions) to be send as attachments. This will only work with files stored in the file-storage.
+        @param file_ids List of file ids (items or revisions) to be sent as attachments. This will only work with files stored in
+               the file-storage.
 
-        @param filesystem_files List of regular files on the filesystem to be send as attachments.
+        @param filesystem_files List of regular files on the
+               filesystem to be sent as attachments.
 
-        @param delete_filesystem_files_p Decides if we want files specified by the 'file' parameter to be deleted once sent.
+        @param delete_filesystem_files_p Decides if we want files specified
+               by the 'file' parameter to be deleted once sent.
 
-        @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html".
+        @param mime_type MIME Type of the mail to send out. Can be
+               "text/plain", "text/html".
 
-        @param extraheaders 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 !!
+        @param extraheaders 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 !!
 
-        @param no_callback Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks
+        @param no_callback Boolean that indicates if callback should
+               be executed or not. If you don't provide it it will
+               execute callbacks
 
-        @param use_sender Boolean indicating that from_addr should be used regardless of fixed-sender parameter
+        @param use_sender Boolean indicating that from_addr should be
+               used regardless of fixed-sender parameter
 
     } {
-
-        # check, if send_immediately is set
-        # if not, take global parameter
+        #
+        # Check, if send_immediately is set if not, take global
+        # parameter.
+        #
         if { !$send_immediately_p } {
-            set send_immediately_p [parameter::get -package_id [get_package_id] -parameter "send_immediately" -default 0]
+            set send_immediately_p [parameter::get \
+                                        -package_id [get_package_id] \
+                                        -parameter "send_immediately" \
+                                        -default 0]
         }
 
-        # if send_immediately_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery
+        #
+        # If send_immediately_p true, then start
+        # acs_mail_lite::send_immediately, so mail is not stored in
+        # the db before delivery.
+        #
         if { $send_immediately_p } {
             acs_mail_lite::send_immediately \
                 -to_addr $to_addr \
@@ -316,19 +387,18 @@
         Send messages in the acs_mail_lite_queue table.
     } {
         # Make sure that only one thread is processing the queue at a time.
-        if {[nsv_incr acs_mail_lite send_mails_p] > 1} {
-            nsv_incr acs_mail_lite send_mails_p -1
+        if {[nsv_incr acs_mail_lite send_mails_p] != 1} {
             return
         }
 
         ad_try {
             db_foreach get_queued_messages {} {
-                # check if record is already there and free to use
-                set return_id [db_string get_queued_message {} -default -1]
-                if {$return_id == $id} {
-                    # lock this record for exclusive use
-                    set locking_server [ad_url]
-                    db_dml lock_queued_message {}
+                # Lock the message and also make sure that it was not
+                # locked or deleted by somebody else in the meantime.
+                set locking_server [ad_url]
+                db_dml lock_queued_message {}
+
+                if {[db_resultrows] == 1} {
                     # send the mail
                     ad_try {
                         acs_mail_lite::send_immediately \
@@ -349,21 +419,36 @@
                             -extraheaders $extraheaders \
                             -use_sender_p $use_sender_p
                     } on error {errorMsg} {
-                        ad_log Error "Could not send queued mail (message $return_id): $errorMsg"
-                        # release the lock (MS not now)
-                        # set locking_server ""
-                        # db_dml lock_queued_message {}
+                        ad_log Error "Could not send queued mail (message $id): $errorMsg"
+                        # Uncommenting the following two lines would
+                        # cause failed emails to be retried at the
+                        # next sweep. This could make sense only for
+                        # certain kinds of errors, so it is best left
+                        # commented and delegated to e.g. downstream
+                        # callbacks.
+                        ## set locking_server ""
+                        ## db_dml lock_queued_message {}
                     } on ok {r} {
                         # mail was sent, delete the queue entry
                         db_dml delete_queue_entry {}
                     }
                 }
             }
         } finally {
-            nsv_incr acs_mail_lite send_mails_p -1
+            nsv_unset acs_mail_lite send_mails_p
         }
     }
 
+    ad_proc -private encode_email_address {email} {
+        set d [lindex [::mime::parseaddress $email] 0]
+        dict with d {
+            if {$phrase ne "" && ![string is ascii -strict $phrase]} {
+                set email "[mime::word_encode utf-8 quoted-printable $phrase] <$address>"
+            }
+        }
+        return $email
+    }
+
     #---------------------------------------
     ad_proc -private send_immediately {
         {-valid_email_p "0"}
@@ -383,56 +468,105 @@
         {-extraheaders ""}
         {-use_sender_p "0"}
         {-object_id ""}
+        {-force_delivery_mode ""}
     } {
 
-        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.
+        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.
 
         @param to_addr List of e-mail addresses to send this mail to.
+
         @param from_addr E-Mail address of the sender.
-        @param reply_to E-Mail address to which replies should go. Defaults to from_addr
+
+        @param reply_to E-Mail address to which replies should
+               go. Defaults to from_addr
+
         @param subject of the email
+
         @param body Text body of the email
-        @param cc_addr List of CC Users e-mail addresses to send this mail to.
-        @param bcc_addr List of CC Users e-mail addresses to send this mail to.
+
+        @param cc_addr List of CC Users e-mail addresses to send this
+               mail to.
+
+        @param bcc_addr List of CC Users e-mail addresses to send this
+               mail to.
+
         @param package_id Package ID of the sending package
-        @param file_ids List of file ids (items or revisions) to be send as attachments. This will only work with files stored in the file-storage.
-        @param filesystem_files List of regular files on the filesystem to be send as attachments.
-        @param delete_filesystem_files_p Decides if we want files specified by the 'file' parameter to be deleted once sent.
-        @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html".
-        @param extraheaders 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 !!
-        @param no_callback_p Indicates if callback should be executed or not. If you don't provide it it will execute callbacks.
-        @param use_sender_p Boolean indicating that from_addr should be used regardless of fixed-sender parameter
+
+        @param file_ids List of file ids (items or revisions) to be sent as attachments. This will only work with files
+               stored in the file-storage.
+
+        @param filesystem_files List of regular files on the
+               filesystem to be sent as attachments.
+
+        @param delete_filesystem_files_p Decides if we want files
+               specified by the 'file' parameter to be deleted once
+               sent.
+
+        @param mime_type MIME Type of the mail to send out. Can be
+               "text/plain", "text/html".
+
+        @param extraheaders 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 !!
+
+        @param no_callback_p Indicates if callback should be executed
+               or not. If you don't provide it it will execute
+               callbacks.
+
+        @param use_sender_p Boolean indicating that from_addr should
+               be used regardless of fixed-sender parameter
+
         @param object_id Object id that caused this email to be sent
+
+        @param force_delivery_mode Force the specified delivery mode
+               for this single call
     } {
 
-        # Package_id required by the callback (emmar: no idea what for)
-        set mail_package_id [apm_package_id_from_key "acs-mail-lite"]
+        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" \
+        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] eq 1 } {
+        if { [llength $to_addr] == 1 } {
             set rcpt_id [party::get_by_email -email $to_addr]
             if {$rcpt_id eq ""} {
                 set rcpt_id 0
@@ -449,8 +583,9 @@
 
 
         # Set originator header
-        set originator_email [parameter::get -parameter "OriginatorEmail" \
-                              -package_id $mail_package_id]
+        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
@@ -499,15 +634,15 @@
             }
         }
 
+        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]
+        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]
@@ -528,21 +663,23 @@
                                     -header [list Content-Disposition "attachment; filename=\"$name\""] \
                                     -header [list Content-Description $title] \
                                     -canonical $mime_type \
-                                    -file "[cr_fs_path]$filename"]
+                                    -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 ""]
+            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 file name absolute
+                # make the filename absolute
                 if {[file pathtype $f] ne "absolute"} {
                     set f [file join [pwd] $f]
                 }
@@ -551,7 +688,9 @@
                     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'"
+                    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]
@@ -585,17 +724,60 @@
             mime::setheader $tokens [lindex $header 0] [lindex $header 1]
         }
 
+        # Get the delivery parameters, including SMTP
+        set deliveryDict [get_delivery_parameters]
+
         # Rollout support
-        set delivery_mode [parameter::get -package_id [get_package_id] -parameter EmailDeliveryMode -default default]
+        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 "smtp"
-                set allowed_addr [parameter::get -package_id [get_package_id] -parameter EmailAllow]
+                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] {
 
@@ -611,25 +793,34 @@
 
             }
             redirect {
+                set send_mode $default_send_mode
 
-                set send_mode "smtp"
+                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 ones
-
-                set to_addr [parameter::get -package_id [get_package_id] -parameter EmailRedirectTo]
-                set cc_addr ""
-                set bcc_addr ""
+                    # 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 "smtp"
+                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 ","]]]
+                              [list To [join $to_addr_header ","]]]
 
         if { $cc_addr ne "" } {
             lappend headers_list [list CC [join $cc_addr ","]]
@@ -646,13 +837,32 @@
             lappend headers_list [list DCC [join $bcc_addr ","]]
         }
 
-
-
         set errorMsg ""
         set status ok
 
-        if { $send_mode eq "log" } {
+        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]
@@ -661,27 +871,34 @@
             # Retrieve the email message as a string
             set packaged [mime::buildmessage $tokens]
 
-            # Close all mime tokens
-            mime::finalize $tokens -subordinates all
-
             # Send the email message to the log
-            ns_log Notice "acs-mail-lite::send: $notice\n\n**********\nEnvelope sender: $originator\n\n$packaged\n**********"
+            ns_log Notice "acs-mail-lite::send: $notice\n\n**********\n\
+                Envelope sender: $originator\n\n$packaged\n**********"
 
-        } else {
+        } elseif {$send_mode eq "smtp"} {
 
             ad_try {
                 acs_mail_lite::smtp -multi_token $tokens \
                     -headers $headers_list \
-                    -originator $originator
+                    -originator $originator \
+                    -delivery_dict $deliveryDict
             } on error {errorMsg} {
                 set status error
             }
 
-            # Close all mime tokens
-            mime::finalize $tokens -subordinates all
-
+        } 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 \
@@ -715,20 +932,25 @@
     }
 
     #---------------------------------------
-    ad_proc -private message_interpolate {
+    ad_proc -deprecated -private message_interpolate {
         {-values:required}
         {-text:required}
     } {
-        Interpolates a set of values into a string. This is directly copied from the bulk mail package
+        Interpolates a set of values into a string. This is directly
+        copied from the bulk mail package.
 
+        DEPRECATED: duplicated code from bulk-mail that could be replaced by
+                    "string map"
+        @see "string map"
+
         @param values a list of key, value pairs, each one consisting of a
         target string and the value it is to be replaced with.
         @param text the string that is to be interpolated
 
         @return the interpolated string
     } {
         foreach pair $values {
-            regsub -all [lindex $pair 0] $text [lindex $pair 1] text
+            regsub -all -- [lindex $pair 0] $text [lindex $pair 1] text
         }
         return $text
     }
@@ -748,12 +970,12 @@
 
     } {
 
-        ns_log Warning "ns_sendmail is no longer supported in OpenACS. Use acs_mail_lite::send instead."
+        ns_log warning "ns_sendmail is deprecated. Use acs_mail_lite::send instead."
 
         set extraheaders_list [list]
 
         if { $extraheaders ne "" } {
-            foreach {key value} [util_ns_set_to_list -set $extraheaders] {
+            foreach {key value} [ns_set array $extraheaders] {
                 lappend extraheaders_list [list $key $value]
             }
         }
@@ -767,7 +989,7 @@
             -extraheaders $extraheaders_list
     }
 
-    ad_proc -public address_domain {} {
+    ad_proc -private address_domain {} {
         @return domain address to which bounces are directed to.
         If empty, uses domain from FixedSenderEmail parameter,
         otherwise the hostname in config.tcl is used.
@@ -787,7 +1009,7 @@
                 # If there is no domain configured, use the configured
                 # hostname as domain name
                 #
-                foreach driver {nsssl nssock_v4 nssock_v6 nssock} {
+                foreach driver [lmap d [ns_driver info] {dict get $d module}] {
                     set section [ns_driversection -driver $driver]
                     set configured_hostname [ns_config $section hostname]
                     if {$configured_hostname ne ""} {
@@ -799,6 +1021,35 @@
         }
         return $domain
     }
+
+    ad_proc configured_p {} {
+
+        Determine, whether the outgoing SMTPHost is configured and
+        reachable.
+
+    } {
+        #
+        # We have currently no good way to check, whether the outgoing
+        # email server is fully configured and accepts our
+        # emails. Here we check only, whether we can connect to the
+        # configured server.
+        #
+        set success 0
+        set params [get_delivery_parameters]
+
+        try {
+            lassign [ns_sockopen -timeout 100ms [dict get $params SMTPHost] [dict get $params SMTPPort]] rid wid
+            set readCheck [ns_sockcheck $rid]
+            set writeCheck [ns_sockcheck $wid]
+            set success [expr {$readCheck && $writeCheck}]
+        } on error {errorMsg} {
+        } finally {
+            catch {close $rid}
+            catch {close $wid}
+        }
+
+        return $success
+    }
 }
 
 # Local variables: