#!/usr/bin/wish

set connected 0 

# Variables devant contenir les valeurs a envoyer au serveur SMTP. 

set tfrom "root"
set tto $tfrom
set tsujet "Client smtp"

# Valeur affichee sur la ligne de status (liee au label .status.status)

set status "Ready"

# Procedure de connexion au service smtp 

proc CX {} {
global s
global status
global connected 

# Ouverture de la socket cliente (connexion au serveur) 

set s [ socket localhost smtp ] 

# On la configure sans buffer d'E/S et pour envoyer 

# des \r\n (crlf) au lieu de \n (lf) 

fconfigure $s -buffering none -translation crlf 

# On lit le message envoye par le serveur smtp 

# (version du logiciel de mail) 

gets $s status 

# On envoie la commande HELO suivie d'un domaine 

# puis on attend le message d'acquittement du serveur 

puts $s "HELO Yoopee" 

gets $s stat 

# On ne prend que les 50 premiers caracteres 

set status [ string range $stat 0 50 ] 

set connected 1 

.status.envoi configure -state normal 

} 

# Procedure de fermeture de la connexion 

proc FIN {} { 

global s 

global status 

global connected 

# On envoie QUIT puis on attend la reponse du serveur 

puts $s "QUIT" 

gets $s status 

# On ferme la socket 

close $s 

set connected 0 

.status.envoi configure -state disabled 

} 

# Procedure cliente SMTP 

proc SMTP {} { 

global tfrom 

global tto 

global tsujet 

global status 

global s 

# Recuperation du texte du mail 

set tdata [ .bas.data get 1.0 end ] 

# Envoi du mail par le protocole smtp 

# Le serveur envoie des chaines d'acquittement 

# pour les commandes MAIL, RCPT, DATA et "." 

puts $s "MAIL FROM: $tfrom" 

gets $s status 

puts $s "RCPT TO: $tto" 

gets $s status 

puts $s "DATA" 

gets $s status 

puts $s "Subject: $tsujet" 

puts $s "$tdata" 

puts $s "." 

gets $s status 

} 

# Procedure qui gere l'appui sur le bouton CX/FIN 

proc CXFIN {} { 

global connected 

if { $connected } { 

FIN 

} else { 

CX 

} 

} 

# Description des controles de l'interface 

frame .haut 

frame .bas 

frame .status 

frame .haut.gauche 

frame .haut.droite 

label .haut.gauche.lfrom -text "From:" 

label .haut.gauche.lto -text "To:" 

label .haut.gauche.lsubject -text "Subject:" 

entry .haut.droite.from -width 64 -textvariable tfrom 

entry .haut.droite.to -width 64 -textvariable tto 

entry .haut.droite.subject -width 64 -textvariable tsujet 

text .bas.data -width 72 

label .status.status -textvariable status 

button .status.envoi -text "Envoyer" -underline 0 -state disabled -command { SMTP } 

button .status.quit -text "CX/FIN" -underline 0 -command { CXFIN } 

# Mise en place des controles de l'interface 

pack .haut.gauche.lfrom .haut.gauche.lto .haut.gauche.lsubject -anchor e 

pack .haut.droite.from .haut.droite.to .haut.droite.subject -anchor w 

pack .bas.data 

pack .haut.gauche .haut.droite -side left 

pack .status.envoi -side right 

pack .status.quit -side right 

pack .status.status -side left 

pack .haut .bas -anchor w 

pack .status -fill x