SMTP with attachments

SV (2003-10-14)

Response on request from LV on news:comp.lang.tcl

Subject: tcllib 1.0 - mime encoding mail attachments
Date: 2003-10-13

tested with 8.4.4 on windows 98

SMTP server: 602Pro Lan Suite
email client: Outlook Express.

## made from example on ASPN by Jeff Hobbs and some code from
## nstcl (AOLserver/OpenNSD-style routines for tclsh)
##   Copyright (c) 2000, 2001, 2002 Michael A. Cleverly
##
##   Sinisa Vujic, Datagram d.o.o., 2003
## script which sends self as attachment
##
## 8.4.3 with trf2.1p1 has problems when location
## of Trf package isn't explicitly stated like this
## set ::env(PATH) $::env(PATH)\;H:/tcl/lib/trf
## because Trf can't find crypt.dll

package require smtp

namespace eval dg_mail {
    namespace export sendmail

    variable mailhost 127.0.0.1
    variable mailport 25
}

proc dg_mail::sendmail {to from subject body {headers ""} {bcc ""}
                        {opt_attcs_type ""} {attcs_array_name ""}} {

    if {[string length $opt_attcs_type]} {
        if {$opt_attcs_type != "-file" && $opt_attcs_type != "-string"} {
            error "unknown option $opt_attcs_type"
        }
        if {![string length $attcs_array_name]} {
            error "unknown value for option $opt_attcs_type"
        }
        upvar 0 $attcs_array_name attcs_array
        set parts [::mime::initialize -canonical text/plain -string $body]
        foreach {attc_name attc_options} [array get attcs_array] {
            set part [eval ::mime::initialize $attc_options]
            lappend parts $part
        }
        set messageT [::mime::initialize -canonical multipart/mixed -parts $parts]
    } else {
        set messageT [::mime::initialize -canonical text/plain -string $body]
    }

    variable mailhost
    variable mailport

    set command [list ::smtp::sendmessage $messageT -servers $mailhost -ports  $mailport]

    lappend command -header [list From $from]
    lappend command -header [list To $to]
    lappend command -header [list Subject $subject]

    if {[string length $bcc]} {
        lappend command -header [list Bcc $bcc]
    }

    if {[string length $headers]} {
        foreach {key value} $headers {
            lappend command -header [list $key $value]
        }
    }

    set err [catch { eval $command } result]
    ::mime::finalize $messageT -subordinates all

    if {$err} {error $result}
}

array set attcs_options {}
set attcs [file join [pwd] [info script]]

foreach attc $attcs {
    ## charset is optional
    set opts [list -canonical "text/plain; charset=ascii; name=\"[file tail $attc]\""]
    lappend opts -encoding quoted-printable
    lappend opts -header {Content-Disposition attachment}
    lappend opts -file $attc
    set attcs_options($attc) $opts
}

dg_mail::sendmail [email protected] [email protected] {Tcl smtp!} Hello! "" "" \
    -file [namespace current]::attcs_options

snichols I tested this script, and everything worked except for the file attachment part. FYI ... I did get the attachment add to work, but changed the last argument to a filename not Tcl array, and changed the following code in the main email proc above:

         if {[string length $opt_attcs_type]} {
                 log "Type: $opt_attcs_type"
                 log "Processing: $file"
                
                set parts [mime::initialize -canonical text/plain -string $body]
                set imageT [mime::initialize -canonical "image/tif; name=\"[file tail $file]\"" -file $file]
                
                lappend parts $imageT
                                
                 set messageT [::mime::initialize -canonical multipart/mixed -parts $parts]
         } else {
                 set messageT [::mime::initialize -canonical text/plain -string $body]
         }

Basically, I can get away with this, because I am only adding one attachment per email and it will always be of the type tif.

SV (2005-03-13) Somewhere between revisions this line become invalid

         set opts [list -canonical "text/plain; charset=\"[file tail $attc]\""]

Now I changed it back to:

         set opts [list -canonical "text/plain; charset=ascii; name=\"[file tail $attc]\""]

Of course one must vary with 'canonical', 'encoding' and optionaly 'charset' in regard to mime type of attachments. Hope it helps.

snichols Thanks SV. Yes, your explanation helps. I got it working, anyway, but it's nice to see there really was an issue with the code, and others will not have to troubleshoot this again. :)

snichols April 3rd, 2006. I really like your coding example of using the SMTP package with attachments. So, I'm sharing with others my code used in getting PDF file attachments to work with your sendmail proc. Notice the base64 encoding and change in canonical in this snipit of code:

# Example of how to use sendmail proc with PDF file types.
foreach attc $attcs {
        ## charset is optional
        set opts [list -canonical "application/pdf; name=\"[file tail $attc]\""]
        lappend opts -encoding base64
        lappend opts -header {Content-Disposition attachment}
        lappend opts -file $attc
        log "Adding $opts to attachment array."
        set attcs_options($attc) $opts
}
# Note: without the base64 encoding of the attachment I got errors when opening the attachment sent via email.

Bezoar 5/14/2014 - for a general catchall mime type that will send all types of files use application/octet-stream

# Example of how to use sendmail proc with All file types use this minor change to the above code
foreach attc $attcs {
        ## charset is optional
        set opts [list -canonical "application/octet-stream; name=\"[file tail $attc]\""]
        ....

I mailed an 4 MB mp3 and a 1.5M jpeg with this same mime type -cannonical option.

Kroc 12/3/2015 - a quick example to send a PDF:

set parts [mime::initialize -canonical text/plain -string $body]
lappend parts [mime::initialize -canonical "application/pdf; name=\"[file tail $pdfname]\"" -encoding base64\
        -header {Content-Disposition attachment} -file $pdfname]
set token [::mime::initialize -canonical multipart/mixed -parts $parts]
set command [list ::smtp::sendmessage $token\
        -servers $mailhost -ports $mailport -username $mailuser -password $mailpass -usetls 1\
        -header [list From "$mailfrom"] -header [list To "$mailto"] -header [list Subject "$subject"]\
        -header [list Date "[clock format [clock seconds]]"]]
if {[catch {eval $command} err]} {
        error "Error when sending mail: $err"
}
catch {::mime::finalize $token -subordinates all}

EE 2015-12-08 I don't think this is right. In fact, I'm almost entirely certain that passing an eval to the catch command is altogether wrong. Why not use catch $command err instead?