Gmail en imap

dc Gmail est le fameux service de mails de Google.

On peut activer le support [imap] pour consulter la messagerie. Il faut activer une connexion [SSL]. En farfouillant sur le wiki anglophone, j'ai trouvé cette page [1] où Pat Thoyts explique comment activer une telle connexion.

Voilà donc un petit script simple (sans doute un peu naïf compte tenu de ma compréhension des sockets) :

 package require tls

 set idMail monadresse@gmail.com
 set passMail monsupermotdepasse

 set compteur 0

 proc Write {chan} {
    fileevent $chan writable {}
    tls::handshake $chan
    fconfigure $chan -buffering line -blocking 0 -translation crlf
    attenteReponse $chan {\* OK}
    identification $chan
    set nb [recupNbMessages $chan]
    recupInfoMessages $chan $nb
    aurevoir $chan
 }

 proc prefixe {} {
    return [format A%03d [incr ::compteur]]
 }

 proc attenteReponse {chan c} {
    set l [gets $chan]
    while {![regexp $c $l]} {
	set l [gets $chan]
	#if {$l!=""} {puts $l}
    }
    puts $l
    return $l
 }

 proc envoiCommande {chan com {c {A[0-9]+}}} {
    puts $chan $com
    attenteReponse $chan $c
 }

 proc identification {chan} {
    envoiCommande $chan "[prefixe] LOGIN $::idMail $::passMail"
 }

 proc aurevoir {chan} {
    envoiCommande $chan "[prefixe] LOGOUT"
    set ::forever 1
 }

 proc recupNbMessages {chan} {

    puts $chan "[prefixe] SELECT INBOX"

    set l [gets $chan]
    while {![regexp {A[\d]+} $l]} {
	if {[regexp {([\d]+) EXISTS$} $l -> nb]} {
	    puts "$nb nouveaux messages"
	}
	set l [gets $chan]
    }
    puts $l
    return $nb
 }

 proc recupInfoMessages {chan nb} {

    # on récupère/parse les entêtes
    for {set i 0} {$i<$nb} {incr i} {
	puts $chan "[prefixe] FETCH [expr {$i+1}] BODY\[HEADER]"
	puts "Message [expr {$i+1}]"
	set l [gets $chan]
	while {![regexp {A[\d]+ OK Success} $l]} {
	    if {![info exists from]} {
		regexp {From: (.*)$} $l -> from
	    }
	    if {![info exists sujet]} {
		regexp {Subject: (.*)$} $l -> sujet
	    }
	    set l [gets $chan]
	}
	puts "\tDe :\t $from"
	puts "\tSujet :\t $sujet"
	unset from
	unset sujet
    }
 }

 set sock [tls::socket -async imap.gmail.com 993]
 fconfigure $sock -encoding binary -buffering none -blocking 1
 fileevent $sock writable [list Write $sock]
 vwait ::forever

Ça donne en sortie quelque chose comme :

 * OK Gimap ready for requests from ***.***.***.*** p9if153512fkb.0
 A001 OK *****.*****@gmail.com authenticated (Success)
 26 nouveaux messages
 A002 OK [READ-WRITE] INBOX selected. (Success)
 Message 1
        De :     ***** <*****@*****>
        Sujet :  =?ISO-8859-1?Q?N'oubliez_pas_la_f=EAte_des_m=E8res...?=
 Message 2
        De :     ***** <*****@*****>
        Sujet :  =?ISO-8859-1?Q?Re:_la_meilleur_fa=C3=A7on_de_marcher..._was[Re:_[GLA?=
 etc.
 ...
 A029 OK 73 good day (Success)

Voir Aussi