TCL Service

[fedora]

oui pas de souci

tclcopier

namespace eval ::eva_tcl {
variable version "0.2 RC1"
variable eva
 
#********************#
# Service.Socket 1.0 by Alias#
#********************#
 
#**************************#
# Information link reseau. #
#**************************#
 
set eva(serv) "link.***.fr"
set eva(ip) "myip"
set eva(port) "4400"
set eva(pwdlink) "mot de passe"
set eva(info) "TCL Services"
#****************************#
# Configuration des sockets. #
#****************************#
 
set eva(nick) "Eva_TCL"
set eva(identd) "Data"
set eva(host) "localhost.com"
set eva(nom) "Services TCL"
 
#***************************#
# Salon de log des sockets. #
#***************************#
 
set eva(log) "#Services"
set eva(quit01) "Redemarage Service."
set eva(quit02) "Fermeture Service."
 
#****************************************#
# Lancement de la procédure des sockets. #
#****************************************#
proc checkconnect {} {
   if {![info exists eva(idx)]} { utimer 30 [namespace current]::checkconnect } else { xconnect:serv }
}
 
proc xconnect:serv {} {
   variable eva
   if [catch {set eva(idx) [connect $eva(ip) $eva(port)]} err] {
      putlog "Connection error :$err"
      return
   }
   putdcc $eva(idx) "PASS $eva(pwdlink)"
   putdcc $eva(idx) "SERVER $eva(serv) 1 [unixtime] [unixtime] J09 :TCL Services"
   putdcc $eva(idx) ":$eva(serv) NICK $eva(nick) 1 1 $eva(identd) $eva(ip) $eva(serv) :$eva(info)"
   putdcc $eva(idx) ":$eva(nick) MODE $eva(nick) +ikdowgs 16384"
   putdcc $eva(idx) ":$eva(nick) JOIN $eva(log)"
   putdcc $eva(idx) ":$eva(nick) MODE $eva(log) +nOtsv $eva(nick)"
   putdcc $eva(idx) ":$eva(nick) MODE $eva(log) +o $eva(nick)"
   putdcc $eva(idx) ":$eva(nick) TOPIC $eva(log) :1\[Eva Service\] Bienvenue sur le Channel des Logs de \2$eva(nick)\2 !"
   control $eva(idx) [namespace current]::controling_server
   utimer 10 [namespace current]::verify
}
 
#***********************************#
# Verify si le serveur est Connecté #
#***********************************#
 
proc verify {} {
   variable eva
   if [valididx [set [namespace current]::eva(idx)]] {
      utimer 30 [namespace current]::verify
   } else {
      xconnect:serv
   }
}
 
proc controling_server {idx arg} {
   variable eva
   set arg1 [lindex [split $arg " "] 0]
   set arg2 [lindex [split $arg " "] 1]
   set arg3 [lindex [split $arg " "] 2]
   set arg4 [lindex [split $arg " "] 3]
   set arg5 [lindex [split $arg " "] 4]
   set arg6 [lindex [split $arg " "] 5]
   set arg7 [lindex [split $arg " "] 6]
   set arg8 [lindex [split $arg " "] 7]
   set arg10 [string trim [lrange [split $arg " "] 3 end] :]
   if [valididx [set [namespace current]::eva(idx)]] {
   if {$arg2=="PING"} {
      putdcc $eva(idx) ":$eva(serv) PONG $eva(ip) :$eva(serv)"
    }	
    }
 }
#**********************#
# Restart des sockets. #
#**********************#
 
proc eva:restart {args} {
   variable eva
   putdcc $eva(idx) ":$eva(serv) SQUIT $eva(serv) :Restart Sockets."
   catch {close $eva(idx)}
}
 
#********************#
# Rehash du Service. #
#********************#
 
proc eggy:xrehash {nick idx arg} {
   variable eva
   putdcc $idx "\002Rehash de TCL Service et des fichiers\002"
   utimer 4 rehash
}

#*********************#
# Restart du Service. #
#*********************#
 
proc eggy:xrestart {nick idx arg} {
   variable eva
   putdcc $idx "\002Redémarrage de TCL Service\002"
   if [valididx [set [namespace current]::eva(idx)]] {
      putdcc $eva(idx) ":$eva(nick) QUIT :$eva(quit01)"
      putdcc $eva(idx) ":$eva(serv) SQUIT :$eva(serv)"
      catch {close $eva(idx)}
      foreach kill [utimers] {
          if {[lindex $kill 1]=="[namespace current]::verify"} { killutimer [lindex $kill 2] }
      }
    }
    xconnect:serv
}
 
#*****************#
# Die du Service. #
#*****************#
 
proc eggy:xdie {nick idx arg} {
variable eva
    putdcc $idx "\002Arrêt de TCL Service\002"
    if [valididx [set [namespace current]::eva(idx)]] {
       putdcc $eva(idx) ":$eva(nick) QUIT : $eva(quit02)"
       putdcc $eva(idx) ":$eva(serv) SQUIT :$eva(quit02)"
       catch {close $eva(idx)}
       foreach kill [utimers] {
          if {[lindex $kill 1]=="[namespace current]::verify"} { killutimer [lindex $kill 2] }
       }
   }
}
 
proc xop {nick idx arg} {
variable eva
  set salon [lindex $arg 0]
  set pseudo [lindex $arg 1]
  if {$salon=="" || $pseudo=="" || ![string match *#* $salon]} {
	putdcc $idx "\2Utilisation:\2 xop <salon> <pseudo>"
	return 0
  }
if [valididx [set [namespace current]::eva(idx)]] {
putdcc $eva(idx) ":$eva(nick) MODE $salon +o $pseudo"
putdcc $eva(idx) ":$eva(nick) PRIVMSG $eva(log) :\2\[Commande\]\21 $nick \2->\2 xop"
catch {close $eva(idx)}
	}
}
 
proc xdeop {nick idx arg} {
  variable eva
  set salon [lindex $arg 0]
  set pseudo [lindex $arg 1]
  if {$salon=="" || $pseudo=="" || ![string match *#* $salon]} {
	putdcc $idx "\2Utilisation:\2 xdeop <salon> <pseudo>"
	return 0
  }
  if [valididx [set [namespace current]::eva(idx)]] {
  putdcc $eva(idx) ":$eva(nick) MODE $salon -o $pseudo"
  putdcc $eva(idx) ":$eva(nick) PRIVMSG $eva(log) :\[xdéOp\] *** $pseudo sur $salon par: $nick" 
  catch {close $eva(idx)}
	}
  putlog "*** Xdéop par $nick - $pseudo sur $salon"
}
 
 
proc xvoice {nick idx arg} {
  variable eva 
  set salon [lindex $arg 0]
  set pseudo [lindex $arg 1]
  if {$salon=="" || $pseudo=="" || ![string match *#* $salon]} {
	putdcc $idx "\2Utilisation:\2 xvoice <salon> <pseudo>"
	return 0
  }
  if [valididx [set [namespace current]::eva(idx)]] {
  putdcc $eva(idx) ":$eva(nick) MODE $salon +v $pseudo"
  putdcc $eva(idx) ":$eva(nick) PRIVMSG $eva(log) :\[xVoice\] *** $pseudo sur $salon par: $nick" 
  catch {close $eva(idx)}
	}
  putlog "*** Xvoice par $nick - $pseudo sur $salon"
}
 
 
proc xdevoice {nick idx arg} {
variable eva 
  set salon [lindex $arg 0]
  set pseudo [lindex $arg 1]
  if {$salon=="" || $pseudo=="" || ![string match *#* $salon]} {
	putdcc $idx "\2Utilisation:\2 xdevoice <salon> <pseudo>"
	return 0
  }
  if [valididx [set [namespace current]::eva(idx)]] {
  putdcc $eva(idx) ":$eva(nick) MODE $salon -v $pseudo"
  putlog "$eva(idx) :$eva(nick) MODE $salon -v $pseudo"
 putdcc $eva(idx) ":$eva(nick) PRIVMSG $eva(log) :\[xdeVoice\] *** $pseudo sur $salon par: $nick" 
 catch {close $eva(idx)}
	}
  putlog "*** Xdévoice par $nick - $pseudo sur $salon"
}
 
proc Pljoin {hand idx args} {
variable eva
	putdcc $idx "\0034\002\[\002\0031Authentification \0033\037OK\037\0034\002\]"
    if [valididx [set [namespace current]::eva(idx)]] {
	putdcc $eva(idx) ":$eva(nick) PRIVMSG $eva(log) :\0034|Join.Partyline\|\0032 - $hand vient de joindre la party-line."
	catch {close $eva(idx)}
		}
	}
 
proc Plpart {hand idx args} {
	variable eva 
	 if [valididx [set [namespace current]::eva(idx)]] {
	putdcc $eva(idx) ":$eva(nick) PRIVMSG $eva(log) :\0034|Part.Partyline\|\0032 - $hand vient de se déconnecter de la party line."
	catch {close $eva(idx)}   
		}
	}
#****************************#
# Fin du Service Sockets 1.0 #
#****************************#
bind evnt - prerehash [namespace current]::uninstall
bind evnt - prerestart [namespace current]::eva:restart
bind dcc n xrehash [namespace current]::eggy:xrehash
bind dcc n xrestart [namespace current]::eggy:xrestart
bind dcc n xdie [namespace current]::eggy:xdie
bind dcc n xop [namespace current]::xop
bind dcc - xdeop [namespace current]::xdeop
bind dcc - xvoice [namespace current]::xvoice
bind dcc - xdevoice [namespace current]::xdevoice
bind chon - * [namespace current]::Pljoin	
bind chof - * [namespace current]::Plpart
# connection
[namespace current]::xconnect:serv
}
putlog "[file tail [info script]] V[set eva_tcl::version] loaded success"

le souci n'y ai plus a partir du moment ou je kill le pid et relance le service.