Vous n'êtes pas identifié(e).

Top posteurs

Statistiques

Partenaires

  • eXolia Hosting
  • Eggdrop.fr

#1 27/09/2011 23:37:21

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

[SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Cher IRCziens, bonsoir.
J'ai développé un petit service IRC très basique en TCL.
Ce dernier fait office de service pouvant gérer des Géofronts.

Voici sa source :

Table SQL

Code: SQL
CREATE TABLE IF NOT EXISTS `ariane_access` (
  `id` INT(11) NOT NULL AUTO_INCREMENT,
  `login` text NOT NULL,
  `passwd` text NOT NULL,
  `uid` text NOT NULL,
  `level` enum('1','2','3') NOT NULL,
  `suspend` enum('0','1') NOT NULL,
  `authed` enum('0','1') NOT NULL,
  PRIMARY KEY (`id`)
) ENGINE=InnoDB  DEFAULT CHARSET=latin1 AUTO_INCREMENT=1 ;
 
 
INSERT INTO `ariane_access` (`id`, `login`, `passwd`, `uid`, `level`, `suspend`, `authed`) VALUES
(1, 'admin', '25e4ee4e9229397b6b17776bfceaf8e7', '', '3', '0', '0');

Les identifiants par défaut sont les suivants : admin - adminpass (modifiable une fois le service lancé via la commande CHPASS)


Le coeur du système (core.tcl)

Code: TCL
#!/usr/bin/env tcl
 
#   Ariane IRC Service
# ====================
#    Auteur: Diogene
# ====================
#      core.tcl
# ====================
 
proc mysql:connect {} {
  set ::mysqlink [mysqlconnect -host [service::getObj config SQL_HOST] -user [service::getObj config SQL_LOGIN] -password [service::getObj config SQL_PASS] -sock [service::getObj config SQL_SOCK]]
  mysqluse $::mysqlink [service::getObj config SQL_BASE]
}
 
proc mysql:deconnect {} {
  mysqlclose $::mysqlink; unset -nocomplain ::mysqlink
}
 
proc utimer {time data} {
set time [expr $time*1000]
set timer [after $time $data]
return $timer
}
 
namespace eval service {
    set ::service(root)            [file dirname [info script]]
    namespace export getObj irc* 
}
 
proc service::coreInit {} {
 
    loadPackages
    loadFile "conf.tcl"
    loadFile "irc.tcl"
    ircConnection
    mysql:connect
    mysqlsel $::mysqlink "UPDATE `ariane_access` SET `authed` = '0', `uid` = '' WHERE authed = '1'"
    mysql:deconnect
 
}
 
proc service::setConf {index value} {
    variable conf
    set conf($index) $value
}
 
proc service::getObj {objType objIndex} {
    variable conf
	if {$objType == "config"} {
		if { [info exists conf($objIndex)] } {
			return $conf($objIndex)
		} else {return}
	} elseif {$objType == "var"} {
		if { [info exists service($objIndex)] } {
			return $service($objIndex)
		} else {return}
	} else {
		return
	}
}
 
proc service::ircConnection {args} {
 
    variable conf
 
    if { [catch {socket [getObj config LINK_HOST] [getObj config LINK_PORT]} sockID] } {
	puts "## Erreur reçue: $::sockID "
	puts "## Arret automatique du service apres detection d'erreur fatale..."
	exit 1
    }
    fconfigure $sockID -buffering line
    fileevent $sockID readable [list [namespace current]::getData $sockID]
    irc::linkCreate $sockID [getObj config LINK_NAME] [getObj config LINK_PASS] [getObj config LINK_DESC] [getObj config LINK_SID]
}
 
proc service::getData {sockID} {
    gets $sockID data
 
      if { [eof $sockID] } {
          close $sockID
          puts "EOF"
          exit 1
 
	}
    irc::srvEvents $sockID $data [getObj config LINK_SID]
}
 
 
proc service::loadFile {fileName} {
  source $::service(root)/$fileName
}
 
proc service::loadPackages {} {
   package require md5
   package require mysqltcl
}
 
service::coreInit
 
vwait _forever_

Le fichier gérant les évènements IRC (irc.tcl)

Code: TCL
#!/usr/bin/env tcl
 
#   Ariane IRC Service
# ====================
#    Auteur: Diogene
# ====================
#      irc.tcl
# ====================
 
namespace eval irc {
  namespace import -force [namespace parent]::*
}
 
 
proc irc::linkCreate {sockID name passwd desc sid} {
  puts $sockID "SERVER $name $passwd 0 $sid :$desc"
  puts $sockID ":$sid BURST [clock seconds]"
  puts $sockID ":$sid ENDBURST"
  botCreate $sockID [getObj config SERVICE_NICK] [getObj config SERVICE_USER] [getObj config SERVICE_HOST] [getObj config SERVICE_REAL] $sid [getObj config SERVICE_UID] [getObj config SERVICE_CHAN]
}
 
proc irc::botCreate {sockID nick ident host real sid uid chan} {
  puts $sockID ":$sid UID $uid [clock seconds] $nick $host $host $ident $host [clock seconds] +Siosw +ABCKNOQcdfgklnoqtx :$real"
  puts $sockID ":$uid JOIN $chan"
  puts $sockID ":$sid MODE $chan +o $nick"
 
}
 
 
proc irc::setReady {} {
  set ::ready 1
}
 
proc irc::isReady {} {
  if {[info exists ::ready]} {
    return 1
  } else {
    return 0
  }
}
 
proc irc::setInfoUser {args} {
     set value1 [lindex $args 0]
     set value2 [lindex $args 1]
     set value3 [lindex $args 2]
     set ::nick($value1) $value2
     set ::uid($value2) $value1
     set ::ip($value1) $value3
     set ::ip($value2) $value3
}
 
proc irc::getInfoUser {type args} {
  switch -exact $type {
    "nick" {
      return $::nick($args)
    }
    "uid" {
      return $::uid($args)
    }
    "ip" {
      return $::ip($args)
    }
  }
}
 
 
proc irc::srvEvents {sockID data sid} {
  puts $data  
  set u "\037" 
  set r "\026" 
  set b "\002" 
  set k "\003"
  regsub -all $u $data "" data 
  regsub -all $r $data "" data 
  regsub -all $b $data "" data 
  regsub -all $k $data "" data
  regsub -all {\\} $data {\\\\} data
  regsub -all {\{} $data {\{} data
  regsub -all {\}} $data {\}} data
  regsub -all {\]} $data {\]} data
  regsub -all {\[} $data {\[} data
  regsub -all {\"} $data {\"} data
  switch -exact [lindex $data 1] {
     "PING" {
	puts $sockID ":$sid PONG $sid :[lindex $data 2]"
     }
     "ENDBURST" {
	setReady
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002-------- Ariane IRC Service ~ [getObj config LINK_NAME] ------------\002"
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002Serveur :\002 [getObj config LINK_HOST] ([getObj config LINK_PORT])"
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002Canal :\002 [getObj config SERVICE_CHAN]"
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002-------- Ariane IRC Service ~ [getObj config LINK_NAME] ------------\002"
     }
     "UID" {
	set uid [lindex $data 2]
	set nick [lindex $data 4]
	set ip [lindex $data 8]
        setInfoUser $uid $nick $ip
    }
     "QUIT" {
	set uid [string trim [lindex $data 0] :]
        set nick [getInfoUser nick $uid]
	set reason [string trim [join [lrange $data 2 end]] :]
	deauth:user $uid
    }
     "FJOIN" {
        set uid [lindex [split [lindex $data 5] ","] 1]
        set chan [lindex $data 2]
        set nick [getInfoUser nick $uid]
	puts $sockID ":[getObj config SERVICE_UID] MODE $chan +o $uid"	 
    }
     "PART" {
	set uid [string trim [lindex $data 0] :]
        set nick [getInfoUser nick $uid]
	set chan [lindex $data 2]
	set reason [string trim [join [lrange $data 3 end]] :]
    }
     "PRIVMSG" {
	set usr [string trim [lindex $data 0] :]
	set cible [lindex $data 2]
	set cmd [string tolower [string trim [lindex $data 3] :]]
	set args [join [lrange $data 4 end]]
 	if {[string equal -nocase $cible [getObj config SERVICE_UID]]} { geoCommands $sockID $usr $cmd $args }
    }
  }
  switch -exact [lindex $data 4] {
    "223" {
      set author [lindex $data 9]
      set host [string trim [lindex $data 6] :]
      set args [string trim [lrange $data 10 end] :]
      puts $sockID ":[getObj config SERVICE_UID] NOTICE $::x :$host by $author -> $args"
    }
    "219" {
      puts $sockID ":[getObj config SERVICE_UID] NOTICE $::x :~ Fin de la liste ~"
    }
  }
}
 
proc irc::verify:passwd {login passwd} {
      set md5_passwd [md5::md5 -hex $passwd]
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login' AND passwd = '$md5_passwd'"]
      mysql:deconnect
      return $res
}	  	  
 
proc irc::verify:alive {uid} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE uid = '$uid' AND authed = '1'"]
      mysql:deconnect
      return $res
}	  	  	  
 
proc irc::verify:suspend {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login' AND suspend = '1'"]
      mysql:deconnect
      return $res
}	  	  	  
 
proc irc::deauth:user {uid} {
      if {![verify:alive $uid]} {return 0}
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `authed` = '0', `uid` = '' WHERE uid = '$uid'"]
      mysql:deconnect
      return $res
}	  	  	  
 
proc irc::suspend:user {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `suspend` = '1' WHERE login = '$login'"]
      mysql:deconnect
      return $res
}	  	  
 
proc irc::unsuspend:user {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `suspend` = '0' WHERE login = '$login'"]
      mysql:deconnect
      return $res
}	  	  
 
proc irc::auth:user {uid login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `authed` = '1', `uid` = '$uid' WHERE login = '$login'"]
      mysql:deconnect
      return $res
}
 
proc irc::verify:lvl {uid level} {
if {![verify:alive $uid]} {return 0}
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE uid = '$uid' AND level >= '$level'"]
      mysql:deconnect
      return $res
}
 
proc irc::is:owner {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login' AND level = '3'"]
      mysql:deconnect
      return $res
}
 
proc irc::verify:login {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login'"]
      mysql:deconnect
      return $res
}
 
proc irc::geoCommands {sockID usr command data} {
	set value1 [lindex $data 0]
	set value2 [lindex $data 1]
	set value3 [lindex $data 2]
	set value4 [lindex $data 3]
	set value5 [lindex $data 4]
	set lvalue1 [lrange $data 0 end]
	set lvalue2 [lrange $data 1 end]
	set lvalue3 [lrange $data 2 end]
	set lvalue4 [lrange $data 3 end]
	set lvalue5 [lrange $data 4 end]
	switch -exact $command {
		"version" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Ariane\002 :: Geofront Server\002"
		}
		"version" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Ariane\002 :: Geofront Server\002"
		}
		"auth" {
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande Auth:\002 /msg [getObj config SERVICE_NICK] auth <identifiant> <mot-de-passe>\0031"; return}
			if {![verify:passwd $value1 $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Identifiant ou mot de passe incorrect"; return}
			if {[verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 votre session est deja active !"; return}
			if {[verify:suspend $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 votre session est suspendue !"; return}			
			auth:user $usr $value1
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Felicitations:\002 Authentification reussie !"
		}
		"deauth" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			deauth:user $usr
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Felicitations:\002 Desauthentification reussie !"
		}
		"suspend" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande Suspend:\002 /msg [getObj config SERVICE_NICK] suspend <add/del> <login>\0031"; return}
			if {![verify:lvl $usr 2]} {puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Access insuffisant."}
			if {$value1 eq "add"} {
  			  if {[is:owner $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Action interdite."; return 0}
			  if {[verify:suspend $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 deja suspendu !"; return}
			  if {![verify:login $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 - compte inexistant !"; return}			
			  suspend:user $value2
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Suspend:\002 $value2 est maintenant suspendu !"
			} elseif {$value1 eq "del"} {
			  if {![verify:suspend $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 non suspendu !"; return}
			  if {![verify:login $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 - compte inexistant !"; return}			
			  unsuspend:user $value2
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Suspend:\002 $value2 est maintenant actif !"
			} else {
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Valeur $value2 non reconnue !"			  
			}
		}
		"addaccess" {
			set newpass [md5::md5 -hex $value2]
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {[verify:lvl $usr 2]} {
			if {$value1 eq "" || $value2 eq "" || $value3 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Commande Addaccess:\002 /msg [getObj config SERVICE_NICK] addaccess <login> <pass> <level>"; return 0 }
			if {$value3 >= 3} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Le level ne peut pas etre superieur a 2."; return 0}
			if {[verify:login $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Acces existant."; return 0}
			mysql:connect
			mysqlsel $::mysqlink "INSERT INTO ariane_access VALUES('','[mysqlescape $value1]','[mysqlescape $newpass]','','[mysqlescape $value3]','0','0')"
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Addaccess:\002 Access bien ajoute."
			return 0
			}
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Access insuffisant."
		}
		"delaccess" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {[verify:lvl $usr 2]} {
			if {$value1 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Commande Delaccess:\002 /msg [getObj config SERVICE_NICK] delaccess <login>"; return 0 }
			if {![verify:login $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Access introuvable."; return 0}
			if {[is:owner $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Action interdite."; return 0}
			mysql:connect
			mysqlsel $::mysqlink "DELETE FROM ariane_access WHERE login = '[mysqlescape $value1]'"
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Delaccess:\002 Access retire."
			return 0
			}
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Access insuffisant."
		}
		"access" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002~ Liste des Access ~\002"
			mysql:connect
			mysqlsel $::mysqlink "SELECT * FROM ariane_access ORDER BY id"
			if {[mysqlresult $::mysqlink rows] ne 0} {
			  while {[set row [mysqlnext $::mysqlink]] != ""} {
			    set login [lindex $row 1]
			    set level [lindex $row 4]
			    set authed [lindex $row 6]
			    puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :Login: $login - Auth: $authed - Level: $level"
			  }
			}
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Fin de la liste des Access.\002"
		}
		"chanmode" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande ChanMode:\002 /msg [getObj config SERVICE_NICK] chanmode <salon> <mode(s)>\0031"; return}
			puts $sockID ":[getObj config LINK_NAME] MODE $value1 $lvalue2"		 
		}
		"gline" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande G:Line:\002 /msg [getObj config SERVICE_NICK] gline <pseudo> <raison>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] GLINE *@[getInfoUser ip $value1] 1d :$lvalue2"
		}
		"ungline" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande UnG:Line:\002 /msg [getObj config SERVICE_NICK] ungline <host> <\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] GLINE *@$value1"
		}
		"glinelist" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			set ::x $usr
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :~ Liste des G:Line ~"
			puts $sockID ":[getObj config SERVICE_UID] STATS g"
		}
		"kill" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande Kill:\002 /msg [getObj config SERVICE_NICK] kill <pseudo> <raison>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] KILL $value1 :$lvalue2 (Ariane Geofront Server)"		 
		}
		"sajoin" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande SaJoin:\002 /msg [getObj config SERVICE_NICK] sajoin <pseudo> <salon>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] SAJOIN $value1 $value2"		 
		}
		"sapart" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande SaPart:\002 /msg [getObj config SERVICE_NICK] sapart <pseudo> <salon>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] SAPART $value1 $value2"		 
 
		}
		"sanick" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande SaNick:\002 /msg [getObj config SERVICE_NICK] sanick <ancien-pseudo> <nouveau-pseudo>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] SANICK $value1 $lvalue2"		 
		}
		"chpass" {
			set newpass [md5::md5 -hex $value1]
  			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Commande ChPass:\002 /msg [getObj config SERVICE_NICK] chpass <nouveau-code>"; return 0 }
			mysql:connect
			mysqlsel $::mysqlink "UPDATE `ariane_access` SET `passwd` = '$newpass' WHERE uid = '$usr'"
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002ChPass:\002 Reussi."
			return 0
		}
		"commands" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002-------- Ariane IRC Service ~ Commandes ------------\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0037\[\00313UTILISATEUR\0037\]"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033AUTH \0031::\0033 COMMANDS"
			if {[verify:lvl $usr 1]} {
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0037\[\00313GEOFRONT\0037\]"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033CHANMODE \0031:: \0033KILL \0031:: \0033KICK"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033SAJOIN \0031:: \0033SAPART \0031:: \0033SANICK"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033GLINE \0031:: \0033UNGLINE \0031:: \0033GLINELIST \0031:: \0033CHPASS"
			}
			if {[verify:lvl $usr 2]} {
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0037\[\00313MASTER\0037\]"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033ADDACCESS \0031:: \0033DELACCESS \0031:: \0033SUSPEND"
			}
              		puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002-------- Ariane IRC Service ~ Commandes ------------\002"
		}
		default {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur\002 : commande inconnue !"
		}
	}
  }

Le fichier de configuration (conf.tcl)

Code: TCL
#!/usr/bin/env tcl
 
#   Ariane IRC Service
# ====================
#    Auteur: Diogene
# ====================
#    InspIRCd 2.0.x
# ====================
#      conf.tcl
# ====================
 
#=======================#
# Configuration du Link #
#=======================#
 
setConf LINK_HOST     "localhost"
setConf LINK_PORT     "6670"
setConf LINK_NAME     "geofront.server.com"
setConf LINK_PASS     "geopass"
setConf LINK_DESC     "Ariane Geofront Service"
setConf LINK_SID      "522" 
 
#==========#
# Geofront #
#==========#
 
setConf SERVICE_NICK "Ariane"
setConf SERVICE_HOST "geofront.server.com"
setConf SERVICE_USER "service"
setConf SERVICE_REAL "~ Geofront Service ~"
setConf SERVICE_UID  "522AAAAAA"
setConf SERVICE_CHAN "#Services"
 
#=========#
#  mySQL  #
#=========#
 
setConf SQL_HOST  "nom d'hote"
setConf SQL_LOGIN "identifiant"
setConf SQL_PASS  "code"
setConf SQL_BASE  "ariane"
setConf SQL_SOCK  "/var/lib/mysql/mysql.sock" #(Souvent /var/run/mysqld/mysqld.sock)
 
#
#Service développé et testé sous Fedora 15 - InspIRCd 2.0.5
#
#=========================#
# Fin de la configuration #
#=========================#

Requis :

Package : mysqltcl
Package : md5 (disponible dans tcllib de mémoire)


Autres :

Cette version est compatible uniquement sur les serveurs de type InspIRCd utilisant le protocole TS6.
Ceci est une version de test donc si vous trouvez des erreurs, merci de m'en informer sur ce sujet.

Je distribuerai également un petit service banal d'antiproxy (blacklist + dnsbl - blacklist gérée par mysql) compatible InspIRCd 2.0.x (Protocole TS6) d'ici quelques semaines si ceci intéresse quelqu'un.

Bonne soirée à tous.
En espérant que ceci vous sera utile.
Cordialement, Diogene.

Dernière modification par Diogene (27/09/2011 23:50:13)


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

#2 01/10/2011 21:48:35

hardtek
Nouveau IRCzien
Lieu : 127.0.0.1
Inscription : 18/06/2011
Messages : 12

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Zak a écrit :

Diogene les services entre nous les users s en foutent un peu hmm

Et que se soit unreal ou autre un tchat est un tchat lol

Hmmmmmmmmmmm...
Je ne suis pas d'accord, les users et admins (avec toutes les nouveautés qu'il y a eu ces derniéres années Facebook Twitter...) sont a la recherche d'innovation et de nouveaux développement de Services pour rajeunir, moderniser l'irc.

"Et que se soit unreal ou autre un tchat est un tchat lol" <----- Ben non justement le codage de (nouveau) service, rend le serveur de Diogene customisé ce qui en intérrèsse certain... C'est justement ce qui fait la différence entre les autres serveurs...

En plus il a consacrer du temps et il l'a partagé...


ton meilleur ami est ton pire ennemi

Hors ligne

#3 02/10/2011 02:26:16

Damien
Méchant Modérateur.
Lieu : Bruxelles
Inscription : 20/06/2011
Messages : 237
Site Web

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Salut,

L'ajout d'une commande pour lister les accès ne serait pas mal.

Et puis, je sait pas, si c'est moi ou si c'est un problème sur le robot, mais dès qu'un user join un salon quelquonc le robot l'op.


En informatique il n'y a pas de mauvais outils, il n'y a que de mauvais utilisateurs. Le problème le plus récurrent est celui qui se trouve entre la chaise et le clavier.

Hors ligne

#4 02/10/2011 11:53:33

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Bonjour,

Effectivement Judge, j'avais annoncé qu'il s'agissait d'une version de test, je posterais sur ce même sujet le service corrigé.
Pour le autoop, je m'en étais servi lors d'un test, il faut retirer cette ligne :

Code: TCL
    puts $sockID ":[getObj config SERVICE_UID] MODE $chan +o $uid"

Dans ce code :

Code: TCL
     "FJOIN" {
        set uid [lindex [split [lindex $data 5] ","] 1]
        set chan [lindex $data 2]
        set nick [getInfoUser nick $uid]
    puts $sockID ":[getObj config SERVICE_UID] MODE $chan +o $uid"     
    }

La commande des accès est "access", j'ai sûrement oublié de l'inscrire dans la liste des commandes.
La version corrigée sera publiée au cours de la semaine qui arrive.

Cordialement, Diogene.


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

#5 02/10/2011 20:57:21

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

UPDATE : Le fichier gérant les évènements IRC (irc.tcl)

Code: TCL
#!/usr/bin/env tcl
 
#   Ariane IRC Service
# ====================
#    Auteur: Diogene
# ====================
#      irc.tcl
# ====================
 
namespace eval irc {
  namespace import -force [namespace parent]::*
}
 
 
proc irc::linkCreate {sockID name passwd desc sid} {
  puts $sockID "SERVER $name $passwd 0 $sid :$desc"
  puts $sockID ":$sid BURST [clock seconds]"
  puts $sockID ":$sid ENDBURST"
  botCreate $sockID [getObj config SERVICE_NICK] [getObj config SERVICE_USER] [getObj config SERVICE_HOST] [getObj config SERVICE_REAL] $sid [getObj config SERVICE_UID] [getObj config SERVICE_CHAN]
}
 
proc irc::botCreate {sockID nick ident host real sid uid chan} {
  puts $sockID ":$sid UID $uid [clock seconds] $nick $host $host $ident $host [clock seconds] +Siosw +ABCKNOQcdfgklnoqtx :$real"
  puts $sockID ":$uid JOIN $chan"
  puts $sockID ":$sid MODE $chan +o $nick"
 
}
 
 
proc irc::setReady {} {
  set ::ready 1
}
 
proc irc::isReady {} {
  if {[info exists ::ready]} {
    return 1
  } else {
    return 0
  }
}
 
proc irc::setInfoUser {args} {
     set value1 [lindex $args 0]
     set value2 [lindex $args 1]
     set value3 [lindex $args 2]
     set ::nick($value1) $value2
     set ::uid($value2) $value1
     set ::ip($value1) $value3
     set ::ip($value2) $value3
}
 
proc irc::getInfoUser {type args} {
  switch -exact $type {
    "nick" {
      return $::nick($args)
    }
    "uid" {
      return $::uid($args)
    }
    "ip" {
      return $::ip($args)
    }
  }
}
 
 
proc irc::srvEvents {sockID data sid} {  
  set u "\037" 
  set r "\026" 
  set b "\002" 
  set k "\003"
  regsub -all $u $data "" data 
  regsub -all $r $data "" data 
  regsub -all $b $data "" data 
  regsub -all $k $data "" data
  regsub -all {\\} $data {\\\\} data
  regsub -all {\{} $data {\{} data
  regsub -all {\}} $data {\}} data
  regsub -all {\]} $data {\]} data
  regsub -all {\[} $data {\[} data
  regsub -all {\"} $data {\"} data
  switch -exact [lindex $data 1] {
     "PING" {
	puts $sockID ":$sid PONG $sid :[lindex $data 2]"
     }
     "ENDBURST" {
	setReady
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002-------- Ariane IRC Service ~ [getObj config LINK_NAME] ------------\002"
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002Serveur :\002 [getObj config LINK_HOST] ([getObj config LINK_PORT])"
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002Canal :\002 [getObj config SERVICE_CHAN]"
	puts $sockID ":[getObj config SERVICE_UID] PRIVMSG [getObj config SERVICE_CHAN] :\002-------- Ariane IRC Service ~ [getObj config LINK_NAME] ------------\002"
     }
     "UID" {
	set uid [lindex $data 2]
	set nick [lindex $data 4]
	set ip [lindex $data 8]
        setInfoUser $uid $nick $ip
    }
     "QUIT" {
	set uid [string trim [lindex $data 0] :]
        set nick [getInfoUser nick $uid]
	set reason [string trim [join [lrange $data 2 end]] :]
	deauth:user $uid
    }
     "FJOIN" {
        set uid [lindex [split [lindex $data 5] ","] 1]
        set chan [lindex $data 2]
        set nick [getInfoUser nick $uid]
    }
     "PART" {
	set uid [string trim [lindex $data 0] :]
        set nick [getInfoUser nick $uid]
	set chan [lindex $data 2]
	set reason [string trim [join [lrange $data 3 end]] :]
    }
     "PRIVMSG" {
	set usr [string trim [lindex $data 0] :]
	set cible [lindex $data 2]
	set cmd [string tolower [string trim [lindex $data 3] :]]
	set args [join [lrange $data 4 end]]
 	if {[string equal -nocase $cible [getObj config SERVICE_UID]]} { geoCommands $sockID $usr $cmd $args }
    }
  }
  switch -exact [lindex $data 4] {
    "223" {
      set author [lindex $data 9]
      set host [string trim [lindex $data 6] :]
      set args [string trim [lrange $data 10 end] :]
      puts $sockID ":[getObj config SERVICE_UID] NOTICE $::x :$host by $author -> $args"
    }
    "219" {
      puts $sockID ":[getObj config SERVICE_UID] NOTICE $::x :~ Fin de la liste ~"
    }
  }
}
 
proc irc::verify:passwd {login passwd} {
      set md5_passwd [md5::md5 -hex $passwd]
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login' AND passwd = '$md5_passwd'"]
      mysql:deconnect
      return $res
}	  	  
 
proc irc::verify:alive {uid} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE uid = '$uid' AND authed = '1'"]
      mysql:deconnect
      return $res
}	  	  	  
 
proc irc::verify:suspend {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login' AND suspend = '1'"]
      mysql:deconnect
      return $res
}	  	  	  
 
proc irc::deauth:user {uid} {
      if {![verify:alive $uid]} {return 0}
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `authed` = '0', `uid` = '' WHERE uid = '$uid'"]
      mysql:deconnect
      return $res
}	  	  	  
 
proc irc::suspend:user {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `suspend` = '1' WHERE login = '$login'"]
      mysql:deconnect
      return $res
}	  	  
 
proc irc::unsuspend:user {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `suspend` = '0' WHERE login = '$login'"]
      mysql:deconnect
      return $res
}	  	  
 
proc irc::auth:user {uid login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "UPDATE `ariane_access` SET `authed` = '1', `uid` = '$uid' WHERE login = '$login'"]
      mysql:deconnect
      return $res
}
 
proc irc::verify:lvl {uid level} {
if {![verify:alive $uid]} {return 0}
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE uid = '$uid' AND level >= '$level'"]
      mysql:deconnect
      return $res
}
 
proc irc::is:owner {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login' AND level = '3'"]
      mysql:deconnect
      return $res
}
 
proc irc::verify:login {login} {
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login'"]
      mysql:deconnect
      return $res
}
 
proc irc::geoCommands {sockID usr command data} {
	set value1 [lindex $data 0]
	set value2 [lindex $data 1]
	set value3 [lindex $data 2]
	set value4 [lindex $data 3]
	set value5 [lindex $data 4]
	set lvalue1 [lrange $data 0 end]
	set lvalue2 [lrange $data 1 end]
	set lvalue3 [lrange $data 2 end]
	set lvalue4 [lrange $data 3 end]
	set lvalue5 [lrange $data 4 end]
	switch -exact $command {
		"version" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Ariane\002 :: Geofront Server\002"
		}
		"version" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Ariane\002 :: Geofront Server\002"
		}
		"auth" {
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande Auth:\002 /msg [getObj config SERVICE_NICK] auth <identifiant> <mot-de-passe>\0031"; return}
			if {![verify:passwd $value1 $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Identifiant ou mot de passe incorrect"; return}
			if {[verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 votre session est deja active !"; return}
			if {[verify:suspend $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 votre session est suspendue !"; return}			
			auth:user $usr $value1
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Felicitations:\002 Authentification reussie !"
		}
		"deauth" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			deauth:user $usr
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Felicitations:\002 Desauthentification reussie !"
		}
		"suspend" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande Suspend:\002 /msg [getObj config SERVICE_NICK] suspend <add/del> <login>\0031"; return}
			if {![verify:lvl $usr 2]} {puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Access insuffisant."}
			if {$value1 eq "add"} {
  			  if {[is:owner $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Action interdite."; return 0}
			  if {[verify:suspend $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 deja suspendu !"; return}
			  if {![verify:login $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 - compte inexistant !"; return}			
			  suspend:user $value2
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Suspend:\002 $value2 est maintenant suspendu !"
			} elseif {$value1 eq "del"} {
			  if {![verify:suspend $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 non suspendu !"; return}
			  if {![verify:login $value2]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 $value2 - compte inexistant !"; return}			
			  unsuspend:user $value2
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Suspend:\002 $value2 est maintenant actif !"
			} else {
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Valeur $value2 non reconnue !"			  
			}
		}
		"addaccess" {
			set newpass [md5::md5 -hex $value2]
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {[verify:lvl $usr 2]} {
			if {$value1 eq "" || $value2 eq "" || $value3 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Commande Addaccess:\002 /msg [getObj config SERVICE_NICK] addaccess <login> <pass> <level>"; return 0 }
			if {$value3 >= 3} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Le level ne peut pas etre superieur a 2."; return 0}
			if {[verify:login $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Acces existant."; return 0}
			mysql:connect
			mysqlsel $::mysqlink "INSERT INTO ariane_access VALUES('','[mysqlescape $value1]','[mysqlescape $newpass]','','[mysqlescape $value3]','0','0')"
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Addaccess:\002 Access bien ajoute."
			return 0
			}
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Access insuffisant."
		}
		"delaccess" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {[verify:lvl $usr 2]} {
			if {$value1 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Commande Delaccess:\002 /msg [getObj config SERVICE_NICK] delaccess <login>"; return 0 }
			if {![verify:login $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Access introuvable."; return 0}
			if {[is:owner $value1]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Erreur:\002 Action interdite."; return 0}
			mysql:connect
			mysqlsel $::mysqlink "DELETE FROM ariane_access WHERE login = '[mysqlescape $value1]'"
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Delaccess:\002 Access retire."
			return 0
			}
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Access insuffisant."
		}
		"access" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002~ Liste des Access ~\002"
			mysql:connect
			mysqlsel $::mysqlink "SELECT * FROM ariane_access ORDER BY id"
			if {[mysqlresult $::mysqlink rows] ne 0} {
			  while {[set row [mysqlnext $::mysqlink]] != ""} {
			    set login [lindex $row 1]
			    set level [lindex $row 4]
			    set authed [lindex $row 6]
			    puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :Login: $login - Auth: $authed - Level: $level"
			  }
			}
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Fin de la liste des Access.\002"
		}
		"chanmode" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande ChanMode:\002 /msg [getObj config SERVICE_NICK] chanmode <salon> <mode(s)>\0031"; return}
			puts $sockID ":[getObj config LINK_NAME] MODE $value1 $lvalue2"		 
		}
		"gline" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande G:Line:\002 /msg [getObj config SERVICE_NICK] gline <pseudo> <raison>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] GLINE *@[getInfoUser ip $value1] 1d :$lvalue2"
		}
		"zline" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande Z:Line:\002 /msg [getObj config SERVICE_NICK] zline <host/ip> <raison>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] ZLINE $value1 1d :$lvalue2"
		}
 
		"ungline" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande UnG:Line:\002 /msg [getObj config SERVICE_NICK] ungline <host> <\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] GLINE *@$value1"
		}
		"unzline" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande UnZ:Line:\002 /msg [getObj config SERVICE_NICK] unzline <host/ip>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] ZLINE $value1"
		}
		"glinelist" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			set ::x $usr
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :~ Liste des G:Line ~"
			puts $sockID ":[getObj config SERVICE_UID] STATS g"
		}
		"zlinelist" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			set ::x $usr
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :~ Liste des Z:Line ~"
			puts $sockID ":[getObj config SERVICE_UID] STATS Z"
		}
 
		"kill" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande Kill:\002 /msg [getObj config SERVICE_NICK] kill <pseudo> <raison>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] KILL $value1 :$lvalue2 (Ariane Geofront Server)"		 
		}
		"sajoin" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande SaJoin:\002 /msg [getObj config SERVICE_NICK] sajoin <pseudo> <salon>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] SAJOIN $value1 $value2"		 
		}
		"sapart" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande SaPart:\002 /msg [getObj config SERVICE_NICK] sapart <pseudo> <salon>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] SAPART $value1 $value2"		 
 
		}
		"sanick" {
			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq "" || $value2 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0031\002Commande SaNick:\002 /msg [getObj config SERVICE_NICK] sanick <ancien-pseudo> <nouveau-pseudo>\0031"; return}
			puts $sockID ":[getObj config SERVICE_UID] SANICK $value1 $lvalue2"		 
		}
		"chpass" {
			set newpass [md5::md5 -hex $value1]
  			if {![verify:alive $usr]} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur:\002\0031 Vous n'etes pas authentifie !"; return}
			if {$value1 eq ""} { puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002Commande ChPass:\002 /msg [getObj config SERVICE_NICK] chpass <nouveau-code>"; return 0 }
			mysql:connect
			mysqlsel $::mysqlink "UPDATE `ariane_access` SET `passwd` = '$newpass' WHERE uid = '$usr'"
			mysql:deconnect
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002ChPass:\002 Reussi."
			return 0
		}
		"commands" {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002-------- Ariane IRC Service ~ Commandes ------------\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0037\[\00313UTILISATEUR\0037\]"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033AUTH \0031::\0033 COMMANDS \0031::\0033 ACCESS"
			if {[verify:lvl $usr 1]} {
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0037\[\00313GEOFRONT\0037\]"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033CHANMODE \0031:: \0033KILL \0031:: \0033KICK"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033SAJOIN \0031:: \0033SAPART \0031:: \0033SANICK"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033GLINE \0031:: \0033UNGLINE \0031:: \0033GLINELIST \0031::"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033ZLINE \0031:: \0033UNZLINE \0031:: \0033ZLINELIST \0031:: \0033CHPASS"
			}
			if {[verify:lvl $usr 2]} {
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0037\[\00313MASTER\0037\]"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			  puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\0033ADDACCESS \0031:: \0033DELACCESS \0031:: \0033SUSPEND"
			}
              		puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002"
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002-------- Ariane IRC Service ~ Commandes ------------\002"
		}
		default {
			puts $sockID ":[getObj config SERVICE_UID] NOTICE $usr :\002\0031Erreur\002 : commande inconnue !"
		}
	}
  }

Je tiens à remercier Judge pour l'aide apportée.

Cordialement, Diogene.

Dernière modification par Diogene (02/10/2011 21:07:03)


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

#6 02/10/2011 21:08:29

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Zak, on ne te changera pas! tongue
Merci beaucoup hardtek.

Cdlt, Dio.


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

#7 10/02/2012 02:06:19

Ch4d
Nouveau IRCzien
Inscription : 20/01/2012
Messages : 43

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Sa m'interresse mon service pooshy n'est pas gére pour ma version inspircd, Diogene ton service gére seulement les geofronts, tout en mysqltcl ? donc il peut être gérer via une interface web si on le fait comme cela ?

Hors ligne

#8 10/02/2012 02:48:11

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Bonsoir,

En effet, si tu réalises l'interface web, le service serait tout à fait paramétrable depuis celle-ci.

Amicalement, Diogene.


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

#9 27/02/2012 10:56:56

iZy
Nouveau IRCzien
Inscription : 27/08/2011
Messages : 17

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Aaaaaah que vois-je ? Encore du TCL, toujours du TCL !! Il est temps de se mettre à la programmation fonctionnelle mon petit Diogene !

Sinon, j'y connais pas grand chose, mais j'aurais deux suggestions à te faire concernant ton petit code :

Dans un premier temps : est-ce vraiment nécessaire d'utiliser une db SQL ? Si je puis me permettre, à chaque commande reçue, il semblerait que tu te connecte à la DB pour vérifier si l'utilisateur est enregistré. C'est certes une solution, mais accéder à une base de données est assez coûteux comme tu dois le savoir, et donc je ne pense pas que cette solution soit viable si ton robot est utilisé sur un serveur ayant un grand nombre de geofront (sans compter que de petits rigolos pourraient également tenter de le ralentir en le spammant de commandes pour le forcer à se connecter sur la db). Selon moi, il serait plus judicieux de conserver un tableau des utilisateurs enregistrés, ou même de stocker la liste des comptes autorisés dans un fichier mappé en mémoire.

Bon, après j'ai vu une petite procédure :

Code: TCL
proc irc::verify:passwd {login passwd} {
      set md5_passwd [md5::md5 -hex $passwd]
      mysql:connect
      set res [mysqlsel $::mysqlink "SELECT * FROM ariane_access WHERE login = '$login' AND passwd = '$md5_passwd'"]
      mysql:deconnect
      return $res
}

Je sais pas si t'as fait bien attention, mais il me semble que tu  ne sécurise pas les variables $login et $password ce qui voudrait dire qu'il s'agirait d'une petite vulnérabilité SQL. Vérifie si tu contrôle bien ces deux chaines (magic quotes et compagnie) histoire d'éviter qu'un petit malin contourne ton système de mots de passe en saisissant par exemple  $login = Admin' //

Une petite dernière chose (moins importante). Il est interessant d'utiliser un sel avant d'appliquer un hash md5 afin de limiter les attaques par dictionnaire.

Allez à une prochaine !! Et n'oublie pas qu'il est temps pour toi d'entrer dans le fabuleux monde du LISP et du Haskell ;-)

iZy


i love mankind ; it's people i can't stand
[Charles M. Schulz]

Hors ligne

#10 29/02/2012 15:19:48

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

C'est seulement à titre d'exemple ^^.

Cdlt, Dio.


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

#11 02/10/2012 12:36:21

Ch4d
Nouveau IRCzien
Inscription : 20/01/2012
Messages : 43

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Moi j'aimerai bien voir les correction apporté sur ce service que iZy à rapporté concernant les tableau et les faille de login et password smile)), parce que comme il a dit une faille SQL sa peut faire regrétté celui qui a mis se service

Hors ligne

#12 14/10/2012 20:56:57

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Bonsoir,

Le service n'étant plus en développement, les modifications n'ont pas été apportées.
Désolé.

Amicalement, Diogene.


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

#13 16/10/2012 16:29:56

Ch4d
Nouveau IRCzien
Inscription : 20/01/2012
Messages : 43

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Diogene vraiment domage je cherche un a mettre un de tes services qui gèrerai mon futur serveur est-ce que tu as cela ? ne serai-se qu'un seule bot qui gère tous au moins le service pseudo et geofront
smile

Hors ligne

#14 16/10/2012 16:32:46

Ch4d
Nouveau IRCzien
Inscription : 20/01/2012
Messages : 43

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

ah oui et qui gère tout log entrer sorti connection déconnection... du serveur car vraiment je n'en trouve pas un ormi onix de ludo il me semble mais je n'ai pas compris s'il est dispo sous inspircd alors j'ai riens fait pour l'instant

Hors ligne

#15 16/10/2012 18:13:34

Harakiri
Administrateur
Lieu : Paris
Inscription : 02/07/2011
Messages : 260

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Tu pourrais faire ce genre de demande en message privé, ou en tout cas, pas dans ce sujet.
Et puis, il y a une fonction pour éditer.


EOF

Hors ligne

#16 16/10/2012 22:13:34

Diogene
IRCzien
Lieu : Le Mans
Inscription : 09/07/2011
Messages : 179

Re : [SERVICE] Ariane IRC Service - Geofront (InspIRCd 2.0.x)

Bonsoir,

Non, je n'ai rien de tel.
Si tu suis la syntaxe proposé dans ce snippet, tu pourras largement t'en développer un en suivant seulement le protocole d'InspIRCd.

PS : Suis les conseils d'Harakiri, deux posts pour ça..., on est pas sur IRC, c'est un forum ici.

Amicalement, Diogene.

Dernière modification par Diogene (28/02/2015 03:15:11)


Mieux vaut mourir incompris que passer sa vie à s'expliquer. [William Shakespeare]

Bon, c'est Diogene, mais c'est un humain malgré tout [CrazyCat]

Hors ligne

Pied de page des forums

502381 visites ( 241 aujourd'hui ) 10 visiteurs en ligne
Copyright © 2004 - 2013 IRCz