A tcllib based smtp mailer package

JOB Here is an example package one might want to use for adding mail support to an application. Attachements are handled by the code as well. Maybe there are other examples available or published some where, but at the time I was dealing with the problem, I could not find something suitable. So I created this small package, which works fine so far. The code might not work out of the box, due to different server names, etc. ...

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