# smtp_mailer.tcl ---
# -------------------------------------------------------------------------
#    ####   #    #   #####  #####
#   #       ##  ##     #    #    #
#    ####   # ## #     #    #    #
#        #  #    #     #    #####
#   #    #  #    #     #    #
#    ####   #    #     #    #
# -------------------------------------------------------------------------

# Code partially taken from here:
# maildemo.tcl - Copyright (C) 2005 Pat Thoyts <[email protected]>
#
# This program illustrates the steps required to compose a MIME message and
# mail it to a recipient using the tcllib mime and smtp packages.

# Purpose:
# Smtp mailer package, replacement of any external mailer executeable
# like mpack or mutt, allows to develop applications completely
# operating-system independently !
#
# Revision History:
#  Aug.08: Johann Oberdorfer, <[email protected]>
#                             V0.1 - The initial release based on work
#                                    as stated above - many thanks !

package provide smtp_mailer 0.1

namespace eval smtp_mailer {
    variable cfg

    namespace export send_mail

    array set cfg {
        EMAIL_SERVER "localhost"
        SERVER_PORT 25
        TLS_USAGE   0
        TLS_POLICY  "insecure"
        FROM_KEYSTR ""
        DEBUG 0
    }

    switch -- $::tcl_platform(platform) {
        "unix" {
            set cfg(EMAIL_SERVER) "localhost"
        }
        "windows" {
            set cfg(EMAIL_SERVER) "your_server_name"

            # if not specified, the "From" keystring defaults to
            # the user@hostname combination
            # (basically, it could be any kind of string - doesn't
            # necessarily need to be a valid e-mail adress),
            # set user $::tcl_platform(user)
            # set host [info hostname]
            # set cfg(FROM_KEYSTR) "${user}@${host}"

        }
        default {
            puts "WARNING: Mail server is not specified !"
            puts  "  -> Default setting is used instead - but might fail!"
        }
    }

}


# The use of SSL by our client can be controlled by a policy procedure.
# Using this we can specify that we REQUIRE SSL or we can make SSL optional.
# This procedure should return 'secure' to require SSL
# -currentyl unused-
# proc smtp_mailer::_policy {demoarg code diagnostic} {
#    if {$code > 299} {
#        puts stderr "TLS error: $code $diagnostic"
#    }
#    #return secure;      # fail if no TLS
#    return insecure;
# }

proc smtp_mailer::send_mail \
    {to_list cc_list subject body_txt {attach_list {}} } {
        variable cfg

        # Build the main mime. If there are no attachments, then the
        # top-level mime is text/plain and contains the bodytext of the message.
        # If there are attachments, then the toplevel mime is multipart/mixed.
        # The body is in the first child mime and is of type text/plain.
        # All attachments are in subsequent child mimes
        # of type application/octet-stream.

        if {[llength $attach_list] == 0} {

            set cmd [list mime::initialize \
                         -canonical text/plain -string $body_txt]
        } else {
            set parts [mime::initialize \
                           -canonical text/plain \
                           -string $body_txt]

            foreach fname $attach_list {
                if {[file exists $fname]} {
                    lappend parts \
                        [mime::initialize \
                             -canonical application/octet-stream \
                             -file $fname \
                             -encoding base64 \
                             -param [list name [file tail $fname]]]
                }
            }

            set cmd [list mime::initialize \
                         -canonical multipart/mixed \
                         -parts $parts]
        }

        set token [eval $cmd]

        # works:
        #  mime::setheader $token Subject $subject
        #  smtp::sendmessage $token \
            #          -recipients $recipient -servers $cfg(EMAIL_SERVER)

        # unused options:
        # -debug 1
        # -username  $::tcl_platform(user) \
            #  > We can get the password from http_proxy_pass - maybe.
        #  > if {[info exists env(http_proxy_pass)]} {
        #  >   set PASSWORD $env(http_proxy_pass)
        #  > }
        # -password  $::PASSWORD
        # -header [list Date "[clock format [clock seconds]]"]

        set mailargs [list \
                          -debug     $cfg(DEBUG) \
                          -servers   [list $cfg(EMAIL_SERVER)] \
                          -ports     [list $cfg(SERVER_PORT)] \
                          -header    [list Subject $subject] \
                         ]

        if {$cfg(TLS_USAGE) != 0} {
            set mailargs [lappend mailargs \
                              -usetls "$cfg(TLS_USAGE)" \
                              -tlspolicy "$cfg(TLS_POLICY)"]
        }

        if {$cfg(FROM_KEYSTR) != ""} {
            set mailargs [lappend mailargs \
                              -header [list From "$cfg(FROM_KEYSTR)"]]
        }

        foreach item $to_list {
            set mailargs [lappend mailargs \
                              -header [list To "$item"]]
        }

        foreach item $cc_list {
            set mailargs [lappend mailargs \
                              -header [list Cc "$item"]]
        }

        # -----------------------------------------------------------
        set ret [eval [linsert $mailargs 0 smtp::sendmessage $token]]
        # -----------------------------------------------------------
        mime::finalize $token

        # an empty list indicates everything's went well with the mail server
        if {[llength $ret] == 0} {
            return 0
        }

        return $ret
    }


# -------------------------------------------------------------------------
# SMTP - test ...
# -------------------------------------------------------------------------

if 0 {

    if {[set this [info script]] == ""} {set this [info nameofexecutable]}
    set appRoot [file dirname $this]

    # make sure, to load packages from *here*:
    lappend auto_path [file join $appRoot specify_where_to_find_tcllib]


    # note:
    # make sure, there is no version conflict with an
    # already installed tcllib package - like on windows
    # with active-state tcl/tk distri...

    set pkg_list {"base64" "md5" "mime" "smtp"}

    foreach p $pkg_list {
        if {[lsearch [package names] $p] != -1} {
            package forget  $p
        }
    }

    foreach p $pkg_list {
        package require $p
    }


    # test:
    set to_list [list "[email protected]"]
    set cc_list {}
    set attach_list {}

    set subject "Test: This is the subject."
    set body_txt "This is the message."

    smtp_mailer::send_mail \
        $to_list $cc_list $subject $body_txt $attach_list
}