Envoyer un courrier

 

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_options

DC 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 ?


Miko

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 ^^