David Cobac 28 juillet 2004 : pour envoyer un email, on utilise le protocole smtp. On appelle le package smtp inclus dans la bibliothèque TclLib. Voici un exemple quasiment tiré de l'aide de smtp :
package require smtp
namespace eval courrier {
# mes paramètres
variable serveur_SMTP smtp.free.fr
variable port 25
variable envoyeur david.cobacnospam@free.fr
variable destinataire
}
proc courrier::envoi_message {objet message} {
set token [mime::initialize -canonical text/plain \
-string $message]
mime::setheader $token Subject $objet
smtp::sendmessage $token \
-recipients ${courrier::destinataire}\
-servers ${courrier::serveur_SMTP}\
-originator ${courrier::envoyeur}\
-ports ${courrier::port}
mime::finalize $token
}
set courrier::destinataire UneAdresseValideIci@DomaineValide.fr
courrier::envoi_message "Test" "Ceci est un test de l'envoi"JM. Philippe 19/08/2004 Voici la variante avec pièces attachées que j'ai dû récupérer sur le Tcl cookbook d'ActiveState puis modifier un peu.
package require smtp
package require mime
namespace eval courrier {
# mes paramètres
variable serveur_SMTP smtp.free.fr
variable port 25
}
# 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
# envoie le message avec ses pièces attachées
proc courrier::send_mail_attach {from to subject body {bcc ""} {opt_attcs_type ""} {attcs_array_name ""}} {
variable server port
# initialisations
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]
}
# consituer la commande d'envoi du message
set command [list ::smtp::sendmessage $messageT -servers $server -ports $port]
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]
}
# évaluer la commande
set err [catch {eval $command} result]
::mime::finalize $messageT -subordinates all
if {$err} {error $result}
}
# attache un fichier dans le tableau de pièces attachées
proc courrier::attach_text_file {FileName ArrayName} {
upvar $ArrayName attcs_options
## charset is optional
set opts [list -canonical "text/plain; charset=ascii; name=\"[file tail $FileName]\""]
lappend opts -encoding quoted-printable
lappend opts -header {Content-Disposition attachment}
lappend opts -file $FileName
set attcs_options($FileName) $opts
}
# test -> envoie le script courant en pièce attachée
array unset attcs_options
courrier::attach_text_file [file join [pwd] [info script]] attcs_options
courrier::send_mail_attach <from-machin@...> <to-machin@...> Sujet Hello! "" -file ::attcs_optionsDC Le script précédent semble ne pas fonctionner vraiment...
la procédure courrier::send_mail_attach n'aime pas trop le traitement
variable server port
qu'il faudrait remplacer par
variable server variable port
mais avec une variable server existante, dans le namespace c'est la variable serveur_SMTP qui est définie.
Ce sont des détails en comparaison avec l'erreur que l'on retrouve dans les deux scripts à l'exécution :
unable to convert date-time string "07 mai 2005 17:27:41"
while executing
"clock scan $gmt"
("proper" arm line 3)
invoked from within
"switch -- $property {
hour {
set value [clock format $clock -format %H]
}
lmonth {
return [clock form..."
(procedure "::mime::parsedatetime" line 8)
invoked from within
"::mime::parsedatetime -now proper"
(procedure "smtp::sendmessage" line 262)
invoked from within
"smtp::sendmessage $token -recipients ${courrier::destinataire} -servers ${courrier::serveur_SMTP} -originator ${courrier::envoyeur} -ports ${courrier..."
(procedure "courrier::envoi_message" line 4)
invoked from within
"courrier::envoi_message "Test" "Ceci est un test de l'envoi""
(file "/travail/david/info/tcl/essais/essai_smtp.tcl" line 24)Il semblerait qu'il y ait un problème de locale dans cette affaire... Que faire ?
Perso, j'utilise ces procs, tustées sur le wiki anglophone, pas d'appel au package smtp.
proc drain channel {
# lit la réponse du serveur
gets $channel
}
proc puts_now {channel text} {
puts $channel $text
flush $channel
}
# voir RFC 821
proc send_SMTP_mail {SMTP_host recipients from subject text} {
set standard_SMTP_socket 25
set socket [socket $SMTP_host $standard_SMTP_socket]
puts_now $socket "MAIL From:<$from>"
drain $socket
foreach recipient $recipients {
puts_now $socket "RCPT To:<$recipient>"
}
drain $socket
puts_now $socket DATA
drain $socket
puts $socket "From: <$from>"
puts $socket "To: <$recipients>"
puts $socket "Subject: $subject\n"
# Uniformise les saut de lignes.
foreach line [split $text \n] {
puts $socket [join $line]
}
puts $socket .\nQUIT
drain $socket
close $socket
}on utilise comme ceci:
send_SMTP_mail $smtp $destinataire $expediteur $sujet $corpsdumessage
ou $smtp est l'adresse ip du serveur (ou son nom canonique) et les autres variables, ce que leur nom indique...
FDP 22 mai 2007 : j'ai enlevé le "s" dans cette boucle
foreach recipient $recipients { puts_now $socket "RCPT To:<$recipients>" }
sinon on ne peut pas envoyer le mail à plusieurs destinataires (j'avais ce soucis, résolue avec cette modif)
Kroc - 09 octobre 2007 : moi j'utilise cette version légèrement améliorée :
################################################################################
# Envoie un courriel conformément à la RFC 821 :
proc ::courriel {de pour sujet texte hote {port 25}} {
set S [socket $hote $port]
fconfigure $S -buffering none -encoding utf-8 -translation crlf
fileevent $S readable {gets $S}
puts $S "MAIL From:<$de>"
foreach dest $pour {puts $S "RCPT To:<$dest>"}
puts $S DATA
puts $S "From: <$de>"
foreach dest $pour {puts $S "To: <$dest>"}
puts $S "Subject: $sujet"
puts $S "Date: [clock format [clock second]]"
puts $S "MIME-Version: 1.0"
puts $S "Content-Type: text/plain; charset=\"utf-8\""
puts $S "Content-Transfer-Encoding: 8bit"
puts $S "\n$texte"
puts $S .\nQUIT
close $S
}FDP - 03 avril 2008 : version de kroc efficace je confirme ^^