socket non-bloquant

 

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..."
 }