Kroc - 25 Mars 2009 : A l'origine, j'ai écrit ce script pour tester la disponibilité d'un serveur FTP sans bloquer le reste de mon application, que le serveur soit accessible ou pas.
Les causes possibles d'indiponibilité étant :
Voilà le bazar, basé sur un socket asynchrone lancé dans un thread asynchrone lui aussi :
proc ThreadInit {} {
package require Thread
set ::leFil [::thread::create {
# Vérifie la chaussette :
proc VS {s} {
if {[fconfigure $s -error] ne "" ||
[catch {puts -nonewline $s ""}] ||
[catch {fconfigure $s -peername}]} {
# Pas glop !
set ::R 0
} else {
# Glop ! glop !
set ::R 1
}
}
# Ouvre et lance le test :
proc TS {H P T} {
if {[catch {socket -async $H $P} s]} {
# Pas glop !
return 0
}
fileevent $s writable [list VS $s]
after $T set ::R 0
vwait ::R
close $s
set r $::R
unset ::R
return $r
}
# Attend la suite :
thread::wait
}]
}
proc testSocket {hote port {timeout 1000}} {
while {![info exists ::leFil] || ![thread::exists $::leFil]} {
ThreadInit
}
::thread::send -async $::leFil [list TS $hote $port $timeout] ::@O@
vwait ::@O@
set r ${::@O@}
unset -nocomplain ::@O@
return $r
}Et ça s'utilise comme ça (par exemple) :
if {[testSocket ftp.lr-i.com 21]} {
puts "Cool ftp.lr-i.com est dispo !"
} else {
puts "Qu'est qu'il a encore ce serveur de m..."
}