Bug TCL sur un bind raw

[Gro_MiNeT]

tclcopier

#
###########
# FICHIER #
###########
#
 
if {![file exist xbadhost.db]} {
	set db [open xbadhost.db w+]
	close $db
}
if {![file exist xbadhost.tmp]} {
	set db [open xbadhost.tmp w+]
	close $db
}
 
if {![file exist xprotecthost.db]} {
	set db [open xprotecthost.db w+]
	close $db
}
if {![file exist xprotecthost.tmp]} {
	set db [open xprotecthost.tmp w+]
	close $db
}

 
#
#########################
# PROCDEDURE SERVEUR +S #
#########################
#

 
# Début de la procedure 
 
bind raw - NOTICE xbdhost:notice
proc xbdhost:notice {from key arg} {
 global botnick notc mod
 	set text [split $arg]
 	if ![string equal $from ${::notc:server}] return

# Initialisation du filtre connexion 
 
	if {[join [lrange $text 2 5]] == "Notice -- Client connecting"} {
  	set c_nick [lindex $text 9]
   	set c_user [string range [lindex [split [lindex $text 10] "@"] 0] 1 end]
   	set c_host [string range [lindex [split [lindex $text 10] "@"] 1] 0 end-1]
	set c_userhost "$c_nick!$c_user@$c_host"
     
 
# Contrôle des plages d'ip bannies exeptées
 
	set exempt_masks [open xprotecthost.db r]
	while {![eof $exempt_masks]} {
	set exempt_mask [gets $exempt_masks]
	if {$exempt_masks != ""} { 
	if {[string match -nocase [lindex $exempt_mask 0] $c_host]} { 
	putloglev 3 *  "\27°°°1 UserHost Protégé:\2 Pseudo: \002$c_nick\002 - Userhost: \002$c_user@$c_host\002"
	return 0
 
			} 
		} 
	} 
	close $exempt_masks
	
# expulsion de la plage d'ip bannie
 
	set file xbadhost
	set dbr [open $file.db r]
	while {![eof $dbr]} {
	set r [gets $dbr]
	if {$r!=""} {
	if {[string match -nocase [lindex $r 0] $c_host]} {
	putserv "KLINE $c_user@$c_host $mod(proxyy) :$mod(proxy)"	
	putloglev 3 *  "\213°°°1 XBadHost:\2: Connexion -> Pseudo: $c_nick - Userhost: \002$c_user@$c_host\002"	
	putloglev 3 *  "\213°°°1\2 Correspondance avec \2[lindex $r 0]\2"
	return 0
				}	
			}
		}
		close $dbr
	}
}