Compter le nombre de connexion sur votre serveur

Amand · (This post was last modified: 29/06/2022, 12:33 by Amand.)

Bonjour à tous,

je vous mets à disposition un de mes tcl qui permet de compter le nombre de connexion journalière sur votre serveur IRC à l'aide de la commande !nb .

Tout d'abord il vous faudra une base de donnée sql avec comme structure :

ident (VARCHAR 20),
seen (DATE),
itr (INT 2)

Ensuite voici le tcl:

tcl

#############################
# Compteur.tcl by Amand (www.eggdrop.fr)  #
#############################
 
if {[::tcl::info::commands ::compteurirc::uninstall] eq "::compteurirc::uninstall"} { ::compteurirc::uninstall }
if { [package vcompare [regexp -inline {^[[:digit:]\.]+} $::version] 1.6.20] == -1 } {
putloglev o * "\00304\[compteurirc - erreur\]\003 La version de votre Eggdrop est\00304 ${::version}\003; compteurirc ne fonctionnera correctement que sur les Eggdrops version 1.6.20 ou supérieure." ; return }
if { [::tcl::info::tclversion] < 8.5 } {
putloglev o * "\00304\[compteurirc - erreur\]\003 compteurirc nécessite que Tcl 8.5 (ou plus) soit installé pour fonctionner. Votre version actuelle de Tcl est\00304 ${::tcl_version}\003." ; return }
package require Tcl 8.5
catch {package require mysqltcl}
 
namespace eval ::compteurirc {
 
############
# VARIABLE SQL #
############
 
set ::compteurirc::sql(login) "votre-login"
# Mot de passe
set ::compteurirc::sql(pass) "votre-pass"
# Nom de la base de donnée
set ::compteurirc::sql(db) "nom-de-la-base"
# L'host a l'aquelle ce connecté
set ::compteurirc::sql(host) "localhost"
 
#########
# VARIABLE #
#########
 
# Regexp pour la connection de l'user
set ::compteurirc::regexpclient {:\ (.*)\ \((.*?)@(.*?)\) \[(.*?)\] \[vhost: (.*?)\] .* \[country: (.*?)\] \[reputation: (.*?)\] (.+)}
 
# Procédure de désinstallation : le script se désinstalle totalement avant
# chaque rehash ou à chaque relecture au moyen de la commande "source" ou
# autre.
 
proc ::compteurirc::uninstall {args} {
putlog "Désallocation des ressources de \002compteurirc\002..."
# Suppression des binds.
foreach binding [lsearch -inline -all -regexp [binds *[set ns [::tcl::string::range [namespace current] 2 end]]*] " \{?(::)?$ns"] {
unbind [lindex $binding 0] [lindex $binding 1] [lindex $binding 2] [lindex $binding 4]
}
# Arrêt des utimers en cours.
foreach running_utimer [utimers] {
if { [::tcl::string::match "*[namespace current]::*" [lindex $running_utimer 1]] } { killutimer [lindex $running_utimer 2] }
}
 
namespace delete ::compteurirc
}
}
 
proc ::compteurirc::service:connect {} {
set ::mysqlink [::mysql::connect -host $::compteurirc::sql(host) -user $::compteurirc::sql(login) -password $::compteurirc::sql(pass) -encoding binary]
::mysql::use $::mysqlink $::compteurirc::sql(db)
}
 
proc ::compteurirc::service:deconnect {} {
::mysql::close $::mysqlink; unset -nocomplain ::mysqlink
}
 
##############################
#        PROC TRAITEMENT CONNECTING         #
##############################
 
proc ::compteurirc::who:co {from keyword text} {
 
if {![string match -nocase "*Client connecting*" $text]} {
   return;
}
 
regexp $::compteurirc::regexpclient $text - nick username ip ipdns vhost codepays reputation other
 
  ::compteurirc::CountIRC $username
 
}
 
############
# PROCÉDURES   #
############
 
proc ::compteurirc::nbtoday {nick uhost hand chan arg} {
set format "%Y-%m-%d"
set query "SELECT SUM(itr) as total FROM compteur WHERE seen='[clock format [clock seconds] -format $format]'"
::compteurirc::service:connect
set res [::mysql::sel $::mysqlink $query -flatlist]
::compteurirc::service:deconnect
puthelp "PRIVMSG $chan :Il y a eu $res connexions sur votre serveur irc aujourd'hui à [clock format [clock seconds] -format "%T"]."
}
 
proc ::compteurirc::CountIRC {username} {
 
set now [strftime "%Y-%m-%d"]
set query "SELECT ident,seen FROM compteur WHERE ident='$username' AND seen='$now'"
 
::compteurirc::service:connect
set res [::mysql::sel $::mysqlink $query]
::compteurirc::service:deconnect
 
if {[lindex $res 0] == 1} {
 
set query "UPDATE compteur SET itr=itr+1 WHERE ident='$username' AND seen='$now'"
::compteurirc::service:connect
set res [::mysql::sel $::mysqlink $query]
::compteurirc::service:deconnect
 
} else {
 
set query "INSERT INTO compteur (ident, seen, itr) VALUES ('$username', NOW(), 1)"
::compteurirc::service:connect
set res [::mysql::sel $::mysqlink $query]
::compteurirc::service:deconnect
 
}
 
}
 
#######
#  BIND  #
#######
 
bind pub - !nb ::compteurirc::nbtoday
bind raw - NOTICE ::compteurirc::who:co
bind evnt - prerehash ::compteurirc::uninstall
 
putlog "Compteur IRC (www.eggdrop.fr) a été chargé."

Il incrémentera votre base de donnée pour ajouter une itération pour une connexion déjà existante, ou créera une ligne pour chaque nouvelle connexion.

Ensuite à l'aide de la commande !nb il vous retournera le nombre de connexion à l'heure de l’exécution de la commande.

Pour avoir le nombre de connexion unique de votre serveur irc, il faudra changer la requête :

tcl

set query "SELECT SUM(itr) as total FROM compteur WHERE seen='[clock format [clock seconds] -format $format]'"

en

tcl

set query "SELECT COUNT(itr) as total FROM compteur WHERE seen='[clock format [clock seconds] -format $format]'"

C'est une base, vous pouvez l'optimiser à vos souhaits, par exemple ajouter un bind time pour afficher vos stats toutes les heures ou fin de journée.

L'avantage de la base de donnée sql est que vous pouvez afficher vos statistiques dans une page web.

J'ai plusieurs tcl assez utile et sympathique, il me faudra un peu de temps pour nettoyer le code pour les rendre accessible à tous.

PS: L'eggdrop doit être IRCop et avoir le flag (snomask) +c pour voir la snotice des connexions.

Amand · (This post was last modified: 29/06/2022, 13:05 by Amand.)

Amélioration du code par @"CrazyCat" :

tcl

#############################
# Compteur.tcl by Amand (www.eggdrop.fr)  #
#############################
 
if {[::tcl::info::commands ::compteurirc::uninstall] eq "::compteurirc::uninstall"} { ::compteurirc::uninstall }
if { [package vcompare [regexp -inline {^[[:digit:]\.]+} $::version] 1.6.20] == -1 } {
putloglev o * "\00304\[compteurirc - erreur\]\003 La version de votre Eggdrop est\00304 ${::version}\003; compteurirc ne fonctionnera correctement que sur les Eggdrops version 1.6.20 ou supérieure." ; return }
if { [::tcl::info::tclversion] < 8.5 } {
putloglev o * "\00304\[compteurirc - erreur\]\003 compteurirc nécessite que Tcl 8.5 (ou plus) soit installé pour fonctionner. Votre version actuelle de Tcl est\00304 ${::tcl_version}\003." ; return }
package require Tcl 8.5
catch {package require mysqltcl}
 
namespace eval ::compteurirc {
 
  ############
  # VARIABLE SQL #
  ############
 
  set sql(login) "votre-login"
  # Mot de passe
  set sql(pass) "votre-pass"
  # Nom de la base de donnée
  set sql(db) "nom-de-la-base"
  # L'host a l'aquelle ce connecté
  set sql(host) "localhost"
  
  variable mysqlink
 
  #########
  # VARIABLE #
  #########
 
  # Regexp pour la connection de l'user
  set regexpclient {:\ (.*)\ \((.*?)@(.*?)\) \[(.*?)\] \[vhost: (.*?)\] .* \[country: (.*?)\] \[reputation: (.*?)\] (.+)}
 
  # Procédure de désinstallation : le script se désinstalle totalement avant
  # chaque rehash ou à chaque relecture au moyen de la commande "source" ou
  # autre.
 
  proc uninstall {args} {
      putlog "Désallocation des ressources de \002compteurirc\002..."
      # Suppression des binds.
      foreach binding [lsearch -inline -all -regexp [binds *[set ns [::tcl::string::range [namespace current] 2 end]]*] " \{?(::)?$ns"] {
        unbind [lindex $binding 0] [lindex $binding 1] [lindex $binding 2] [lindex $binding 4]
      }
      # Arrêt des utimers en cours.
      foreach running_utimer [utimers] {
        if { [::tcl::string::match "*[namespace current]::*" [lindex $running_utimer 1]] } { killutimer [lindex $running_utimer 2] }
      }
 
      namespace delete ::compteurirc
  }
 
  proc service:connect {} {
      set ::compteurirc::mysqlink [::mysql::connect -host $::compteurirc::sql(host) -user $::compteurirc::sql(login) -password $::compteurirc::sql(pass) -encoding binary]
      ::mysql::use $::compteurirc::mysqlink $::compteurirc::sql(db)
  }
 
  proc service:deconnect {} {
      ::mysql::close $::compteurirc::mysqlink
      unset -nocomplain ::compteurirc::mysqlink
  }
}
 
##############################
#        PROC TRAITEMENT CONNECTING        #
##############################
 
proc ::compteurirc::who:co {from keyword text} {
  if {![string match -nocase "*Client connecting*" $text]} {
      return;
  } 
  regexp $::compteurirc::regexpclient $text - nick username ip ipdns vhost codepays reputation other
  ::compteurirc::CountIRC $username
}
 
############
# PROCÉDURES  #
############
 
proc ::compteurirc::nbtoday {nick uhost hand chan arg} {
  set format "%Y-%m-%d"
  set query "SELECT SUM(itr) as total FROM compteur WHERE seen='[clock format [clock seconds] -format $format]'"
  ::compteurirc::service:connect
  set res [::mysql::sel $::compteurirc::mysqlink $query -flatlist]
  ::compteurirc::service:deconnect
  puthelp "PRIVMSG $chan :Il y a eu $res connexions sur votre serveur irc aujourd'hui à [clock format [clock seconds] -format "%T"]."
}
 
proc ::compteurirc::CountIRC {username} {
  set now [strftime "%Y-%m-%d"]
  set query "SELECT ident,seen FROM compteur WHERE ident='$username' AND seen='$now'"
  ::compteurirc::service:connect
  set res [::mysql::sel $::compteurirc::mysqlink $query]
  if {[lindex $res 0] == 1} {
      set query "UPDATE compteur SET itr=itr+1 WHERE ident='$username' AND seen='$now'"
  } else {
      set query "INSERT INTO compteur (ident, seen, itr) VALUES ('$username', NOW(), 1)"
  }
  set res [::mysql::sel $::compteurirc::mysqlink $query]
  ::compteurirc::service:deconnect
}
 
#######
#  BIND  #
#######
 
bind pub - !nb ::compteurirc::nbtoday
bind raw - NOTICE ::compteurirc::who:co
bind evnt - prerehash ::compteurirc::uninstall
 
putlog "Compteur IRC (www.eggdrop.fr) a été chargé."

Suppression du namespace dans variables et procédure qui se font déjà dans le namespace.
mysqlink doit être dans le namespace, si on a plusieurs scripts qui utilisent ce nom de variable et qu'elle est globale, ça peut crée des conflits.
Dans la procédure CountIRC, inutile de fermer et d'ouvrir une nouvelle fois la connexion, on garde la même.
Code redondant dans la condition de la proc CountIRC qui crée une requête et l'exécute, on limite à la création de la requête et on l'exécute quoi qu'il arrive.

CrazyCat · 29/06/2022, 14:35

Pour faire suite à la conversation que nous avons eu sur IRC et qui a donné lieu à ce changelog, j'ajouterai qu'il est possible de faire une pseudo couche d'abstraction pour exécuter les requêtes afin de na pas avoir chaque fois l'enchainement "connexion, requête, déconnexion".
Pour ce script là, ce n'est pas bien utile mais je tenterai de faire l'exercice à titre d'exemple dès que j'aurai un peu de temps.

CrazyCat · 30/06/2022, 12:38

Je me réponds à moi-même : inutile de créer une couche d'abstraction, elle existe déjà: TDBC
Je vais faire quelques essais avec afin d'écrire un petit tuto, mais après mes premiers essais ça semble efficace.

Amand · (This post was last modified: 01/07/2022, 21:31 by Amand.)

Nouvelle proposition de modification apportée par @"ZarTek" :

tcl

if { [::tcl::info::commands ::compteurirc::uninstall] eq "::compteurirc::uninstall" } { ::compteurirc::uninstall }
if { [package vcompare [regexp -inline {^[[:digit:]\.]+} $::version] 1.6.20] == -1 } { putloglev o * "\00304\[compteurirc - erreur\]\003 La version de votre Eggdrop est\00304 ${::version}\003; compteurirc ne fonctionnera correctement que sur les Eggdrops version 1.6.20 ou supérieure." ; return }
if [catch {package require Tcl 8.5}] { putloglev o * "\00304\[compteurirc - erreur\]\003 compteurirc nécessite que Tcl 8.5 (ou plus) soit installé pour fonctionner. Votre version actuelle de Tcl est\00304 ${::tcl_version}\003." ; return }
if [catch {package require mysqltcl}] {  putloglev o * "\00304\[compteurirc - erreur\]\003 compteurirc nécessite que mysqltcl soit installé pour fonctionner." ; return }
namespace eval ::compteurirc {
    
    ############
    # VARIABLE SQL #
    ############
 
    # Modifiez ici les valeurs MySQL
    array set sql [list]
;
    # Stop ici..
    
    #########
    # VARIABLE #
    #########
    
    # Regexp pour la connection de l'user
    set regexp_client {:\ (.*)\ \((.*?)@(.*?)\) \[(.*?)\] \[vhost: (.*?)\] .* \[country: (.*?)\] \[reputation: (.*?)\] (.+)}
    
 
    variable mysqlink
    # Procédure de désinstallation : le script se désinstalle totalement avant
    # chaque rehash ou à chaque relecture au moyen de la commande "source" ou
    # autre.
    
    proc uninstall {args} {
        putlog "Désallocation des ressources de \002compteurirc\002..."
        # Suppression des binds.
        foreach binding [lsearch -inline -all -regexp [binds *[set ns [::tcl::string::range [namespace current] 2 end]]*] " \{?(::)?$ns"] {
            unbind [lindex $binding 0] [lindex $binding 1] [lindex $binding 2] [lindex $binding 4]
        }
        namespace delete ::compteurirc
    }
    
    proc service:connect {} {
        variable sql
        variable mysqlink
        if [catch {set mysqlink [::mysql::connect -host $sql(host) -user $sql(login) -password $sql(pass) -encoding binary]} SQL_Erreur] {
            putloglev o * "\00304\[compteurirc - erreur\]\003 Une erreur c'est produite lors de la connexion sql: $SQL_Erreur" ; die $SQL_Erreur
        }
        ::mysql::use $mysqlink $sql(db)
    }
    
    proc service:deconnect {} {
        variable mysqlink
        ::mysql::close $mysqlink
        unset -nocomplain ::compteurirc::mysqlink
    }
}
 
##############################
#        PROC TRAITEMENT CONNECTING        #
##############################
 
proc ::compteurirc::who:co {from keyword text} {
    variable regexp_client
    if { ![string match -nocase "*Client connecting*" $text] } { return; } 
    set regexp_client  {:\ (.*)\ \((.*?)@(.*?)\) \[(.*?)\] \[vhost: (.*?)\] .* \[country: (.*?)\] \[reputation: (.*?)\] (.+)}
    regexp $regexp_client $text - nick username ip ipdns vhost codepays reputation other
    CountIRC $username
}
 
############
# PROCÉDURES  #
############
 
proc ::compteurirc::nbtoday {nick uhost hand chan arg} {
    variable mysqlink
    variable sql
    set today_date  [strftime "%Y-%m-%d"]
    set today_hour  [strftime "%T"]
    set query      "SELECT SUM(`itr`) as `total` "
    append query    "FROM `$sql(tbl)` "
    append query    "WHERE `seen` = '$today_date'"
    service:connect
    set res    [::mysql::sel $mysqlink $query -flatlist]
    service:deconnect
    puthelp "PRIVMSG $chan :Il y a eu $res connexions sur votre serveur irc aujourd'hui à $today_hour."
}
 
proc ::compteurirc::CountIRC {username} {
    variable mysqlink
    variable sql
    set today_date  [strftime "%Y-%m-%d"]
    set query      "SELECT `ident`, `seen` "
    append query    "FROM `$sql(tbl)` "
    append query    "WHERE `ident` = '$username' AND seen = '$today_date'"
    service:connect
    set res [::mysql::sel $mysqlink $query]
    if { [lindex $res 0] == 1 } {
        set query      "UPDATE `$sql(tbl)` "
        append query    "SET `itr`=`itr`+1 "
        append query    "WHERE ident = '$username' AND seen='$today_date'"
    } else {
        set query      "INSERT INTO `$sql(tbl)` "
        append query    "(ident, seen, itr) "
        append query    "VALUES ('$username', NOW(), 1)"
    }
    set res [::mysql::sel $mysqlink $query]
    service:deconnect
}
proc ::compteurirc::Init {} {
    variable sql
    service:connect
    set SQL_INIT    "CREATE DATABASE IF NOT EXISTS `${sql(db)}` "
    append SQL_INIT "CREATE TABLE IF NOT EXISTS `${sql(tbl)}` ( "
    append SQL_INIT "`id` int(11) NOT NULL, "
    append SQL_INIT "`ident` varchar(20) NOT NULL, "
    append SQL_INIT "`seen` date NOT NULL, "
    append SQL_INIT "`itr` int(10) UNSIGNED NOT NULL DEFAULT '0' "
    append SQL_INIT ") ENGINE=InnoDB; "
 
    append SQL_INIT "ALTER TABLE `${sql(tbl)}` "
    append SQL_INIT "ADD PRIMARY KEY (`id`), "
    append SQL_INIT "ADD UNIQUE KEY `UNIQ` (`ident`,`seen`); "
 
    append SQL_INIT "ALTER TABLE `${sql(tbl)}` "
    append SQL_INIT "MODIFY `id` int(11) NOT NULL AUTO_INCREMENT; "
 
    append SQL_INIT "COMMIT; "
 
::compteurirc::Init
#######
#  BIND  #
#######
 
bind pub - !nb ::compteurirc::nbtoday
bind raw - NOTICE ::compteurirc::who:co
bind evnt - prerehash ::compteurirc::uninstall
 
putlog "Compteur IRC (www.eggdrop.fr) a été chargé."

Vérification de la présence du paquet mysqtcl avec erreur info
Correction de la vérification Tcl 8.5
Retrait des timers dans la proc uninstall qui n'utilise aucun timers
Vérification de la connexion à SQL
Les procédures declarées dans le namespace lors de leur appel n'ont pas besoin du namespace ::compteurirc::service:connect -> service:connect
Utilisation de "variable ?varname?" dans les proc pour importer les variables plutôt que l'utilisation de long nom par exemple : $::compteurirc::sql(db) -> variable sql; $sql(db)
Certains 'set' sont des arrays et non des variable simple -> sql(login), convertion en declaration array
Création d'une proc ::compteurirc::Init pour initialiser la base de donnée si elle n'éxiste pas.
Ajout de sql(tbl)
Protection des colonnes sql avec col
Renommage de set now [strftime "%Y-%m-%d"]; en set today_date [strftime "%Y-%m-%d"]
Lecture des requêtes sql sur plusieurs lignes pour améliorer la lecture
Remplacement de [clock format [clock seconds] -format $format] par [strftime "%Y-%m-%d"]
Remplacement de [clock format [clock seconds] -format "%T"] par [strftime "%T"] car ça n'a pas de sens vu que c'est à l'heure actuelle
Ajout des commentaires pour une compréhension rapide du code
Catch lors de la connexion sql, si erreur d'identification ou autres on n’envoie une erreur
Une fonction init, qui vérifie l'éxistence de la base de données ou la crée automatiquement (si l'user sql a les droits)
La colonne itr en INT 3 UNSIGNED car il n'aura jamais de valeur négative (-12) que position 0-999

CrazyCat · 01/07/2022, 20:12

Petite remarque concernant les requêtes: je trouve plus parlant de faire:

tcl

set query      "SELECT `ident`, `seen`  \
FROM `$sql(tbl)`  \
WHERE `ident` = '$username' AND seen = '$today_date'"

My 2 cents

Possibly Related Threads…
Thread		Author	Replies	Views	Last Post
	[Résolu] Comment recupére le nombre de personne d'un salon (Users, Operateur)	Dydouch	4	4,195	01/11/2013, 23:55 Last Post: Dydouch

Login




Remember me Lost Password?