[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 sinisa@datagram.dg djoko2000@datagram.dg {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 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.

----
[[[Category Command]]]