Communauté Eggdrop - Scripts

#dico.py v1.0 - Script Eggdrop

Fri, 06 Mar 2026 20:10:28 +0000

## ⚠️ Version BETA (Test)

Ce script est actuellement en **version bêta** et est fourni à titre de **test**.

Il a été développé avec l'assistance d'une **intelligence artificielle** et a été validé par :
- ✅ 45 tests unitaires (tous passants)
- ✅ 8 stress tests anti-flood (tous passants)
- ✅ Vérification manuelle des fonctionnalités

**Les retours et signalements de bugs sont les bienvenus !**

dicoReverso.py (Taille : 33.33 Ko / Téléchargements : 1)

Recherche ;)

Sun, 27 Apr 2025 11:30:47 +0000

Coucou déjà félicitations pr le site et les téléchargements de TCL qui sont tjrs dispo c'est compliquer de trouver des choses qui date pr se faire des délires nostalgie :p

Je voulait savoir si qqun ici aurais en stock, entrechat (ircu de nix), hakusho et diogene.tcl ? et également un CS5.1 celui que j'ai est ultra buggué :x

Petit délire nostalgique si qqun passe ici un grand merci par avance ;)
kiss

Nuxium

Besoin de shoutcast.tcl

Fri, 11 Apr 2025 15:49:09 +0000

J'ai besoin de Shoutcast.tcl, tous les tcl que j'ai trouvés donnent une erreur
Existe-t-il un tcl qui fonctionne bien avec eggdrop 1.10.0 ?

mon test script assisté par une ia

Sun, 06 Apr 2025 22:14:43 +0000

salut la communauté ,
vais vous proposer un petit travail assisté par une ia , vous pouvez s'en servir ou ça nous sert pour discuter et à le développer aussi

tcl

# -----------------------------------------------------------------------------
# Script YouTube pour Eggdrop Bot IRC
# Version : 1.1.16
# Description : Ce script permet d'intégrer des fonctionnalités YouTube dans un bot IRC.
#               Il permet de rechercher des vidéos YouTube, de détecter automatiquement
#               les liens YouTube partagés dans le chat, et d'afficher des informations
#               détaillées sur les vidéos.
#
# Prérequis :
# - Tcl 8.6 ou supérieur
# - Packages Tcl : http, json, tls
# - Clé API YouTube valide (à configurer par l'utilisateur)
#
# Commandes :
# - !yt  : Recherche une vidéo YouTube basée sur le terme de recherche fourni.
#
# Fonctionnalités :
# - Détection automatique des liens YouTube et affichage des détails des vidéos.
# - Mise en cache des résultats de recherche pour optimiser les appels API.
# - Formatage des messages pour une présentation claire des informations.
# -----------------------------------------------------------------------------

# ---------------------------------------------------------------------
# Configuration Utilisateur
# ---------------------------------------------------------------------
# Veuillez entrer votre clé API YouTube ci-dessous
namespace eval ::youtube {
    # Clé API YouTube (à configurer par l'utilisateur)
    variable api_key "VOTRE_CLE_ICI"
}

# ---------------------------------------------------------------------
# Script Principal (Ne modifiez rien ci-dessous)
# ---------------------------------------------------------------------
 
namespace eval ::youtube {
    # Version du script
    variable script_version "1.1.16"
    # Préfixe pour les messages YouTube
    variable yt_prefix "\002\00301,00You\00300,04Tube\017"
    # Cache pour stocker les résultats de recherche
    variable cache
    # Cache pour stocker les résultats automatiques
    variable auto_cache

    # S'assurer que la version de Tcl est 8.6 ou supérieure pour le support Unicode
    if {[catch {package require Tcl 8.6}]} {
        putlog "Attention : Tcl < 8.6 détecté - Unicode limité"
    }

    # Procédure d'initialisation
    proc init {} {
        # Packages requis
        foreach pkg {http json tls} {
            if {[catch {package require $pkg} err]} {
                error "Package requis manquant : $pkg"
            }
        }
        # Initialiser les caches
        array set ::youtube::cache {}
        array set ::youtube::auto_cache {}
        # Définir le flag YouTube s'il n'est pas déjà défini
        if {![info exists ::youtube_flag_defined]} {
            setudef flag youtube
            set ::youtube_flag_defined 1
        }
        # Lier les commandes à leurs procédures respectives
        bind pub - "!yt" ::youtube::pub:youtube
        bind pubm - "*youtube*" ::youtube::pubm:youtube_auto
        bind pubm - "*youtu.be*" ::youtube::pubm:youtube_auto
        
        # Message de confirmation du chargement du script
        putlog "Script YouTube version $::youtube::script_version chargé. Pour l'activer, utilisez la commande : .chanset #channel +youtube"
    }

    # Procédure pour envoyer un message YouTube
    proc send_youtube_message {target message {type "PRIVMSG"}} {
        variable yt_prefix
        if {$type eq "PRIVMSG"} {
            puthelp "PRIVMSG $target :${yt_prefix}\003 $message"
        } elseif {$type eq "NOTICE"} {
            puthelp "NOTICE $target :$message\003"
        }
    }

    # Procédure pour vérifier si YouTube est activé pour un canal
    proc check_youtube_enabled {chan {silent 0}} {
        set enabled [channel get $chan youtube]
        if {!$enabled && !$silent} {
            send_youtube_message $chan "Erreur : YouTube non activé (activer via DCC chat)"
        }
        return $enabled
    }

    # Gestionnaire pour la commande !yt
    proc pub:youtube {nick host hand chan arg} {
        variable cache
        if {![check_youtube_enabled $chan]} { return }
        set query [string trim $arg]
        if {$query eq ""} {
            send_youtube_message $chan "Utilisation : !yt "
            return
        }
        if {[info exists cache($query)]} {
            send_youtube_message $chan $cache($query)
            return
        }
        upvar #0 ::youtube::title title
        upvar #0 ::youtube::video_id video_id
        if {[catch {search_youtube $nick $chan $query} err]} {
            send_youtube_message $chan "Erreur : $err"
            return
        }
        upvar #0 ::youtube::channel_title channel_title
        upvar #0 ::youtube::duration duration
        upvar #0 ::youtube::views views
        upvar #0 ::youtube::published_at published_at
        upvar #0 ::youtube::video_link video_link
        if {[catch {process_youtube_url $nick $chan $video_id $query} err]} {
            send_youtube_message $chan "Erreur lors de la récupération des détails : $err"
            return
        }
        set message [format_yt_message [list $title $channel_title $duration $views $published_at $video_link]]
        set cache($query) $message
        utimer 300 [list unset ::youtube::cache($query)]
        send_youtube_message $chan $message
    }

    # Gestionnaire pour la détection automatique des liens YouTube dans les messages
    proc pubm:youtube_auto {nick host hand chan text} {
        variable auto_cache
        if {![check_youtube_enabled $chan 1]} { return }
        if {[string match "!yt*" $text]} { return }
        set youtube_pattern {(?:https?://)?(?:www\.|m\.)?(?:youtube\.com/(?:watch\?v=|shorts/|embed/|live/)|youtu\.be/)([^&\s\?]+)}
        set music_pattern {(?:https?://)?(?:www\.|m\.)?music\.youtube\.com/watch\?v=([^&\s\?]+)}
        if {![regexp $youtube_pattern $text] && ![regexp $music_pattern $text]} { return }
 
        set ids [regexp -all -inline $youtube_pattern $text]
        set music_ids [regexp -all -inline $music_pattern $text]
        foreach {match id} $ids {
            if {[info exists auto_cache($id)]} {
                send_youtube_message $chan $auto_cache($id)
                continue
            }
            if {[catch {process_youtube_url $nick $chan $id $text "" 0} err]} {
                continue
            }
            upvar #0 ::youtube::title title
            upvar #0 ::youtube::channel_title channel_title
            upvar #0 ::youtube::duration duration
            upvar #0 ::youtube::views views
            upvar #0 ::youtube::published_at published_at
            if {$title eq ""} {
                continue
            }
            set message [format_yt_message [list $title $channel_title $duration $views $published_at]]
            set auto_cache($id) $message
            utimer 300 [list unset ::youtube::auto_cache($id)]
            send_youtube_message $chan $message
        }
        foreach {match music_id} $music_ids {
            if {[info exists auto_cache($music_id)]} {
                send_youtube_message $chan $auto_cache($music_id)
                continue
            }
            if {[catch {process_youtube_url $nick $chan $music_id $text "music" 0} err]} {
                continue
            }
            upvar #0 ::youtube::title title
            upvar #0 ::youtube::channel_title channel_title
            upvar #0 ::youtube::duration duration
            upvar #0 ::youtube::views views
            upvar #0 ::youtube::published_at published_at
            if {$title eq ""} {
                continue
            }
            set message [format_yt_message [list $title $channel_title $duration $views $published_at]]
            set auto_cache($music_id) $message
            utimer 300 [list unset ::youtube::auto_cache($music_id)]
            send_youtube_message $chan $message
        }
    }

    # Procédure pour encoder une requête URL
    proc url_encode {query} {
        set encoded ""
        foreach char [split $query ""] {
            if {[regexp {^[a-zA-Z0-9]$} $char]} {
                append encoded $char
            } else {
                scan $char %c code
                append encoded [format "%%%02X" $code]
            }
        }
        return $encoded
    }

    # Procédure pour nettoyer et formater les titres des vidéos
    proc clean_title {title {keep_emojis 0}} {
        set cleaned $title
        if {!$keep_emojis} {
            set cleaned [string map {
                "í ¼í·©í ¼í·¿" "" "í ¼í·²í ¼í·¦" "" "í ¼í·¨" "" "í ¼í·§" "" 
                "í ¼í·ª" "" "í ¼í·«" "" "í ¼í·¬" "" "í ¼í·" "" 
                "í ¼í·®" "" "í ¼í·¯" "" "í ¼í·°" "" "í ¼í·±" "" 
                "í ¼í¸" "" "í ¼í¹" "" "í ¼íº" "" "í ¼í»" "" 
                "í" "" "¼" "" "ÿ" "" "\n" " "
            } $cleaned]
            regsub -all {[^[:alnum:][:space:][:punct:]\u4e00-\u9FFF]} $cleaned "" cleaned
        }
        return [string trim $cleaned]
    }

    # Procédure pour récupérer les données YouTube avec des tentatives répétées
    proc fetch_youtube_data {url chan} {
        catch {package require tls}
        ::http::register https 443 [list ::tls::socket -tls1 1]
        set token ""
        for {set i 1} {$i <= 5} {incr i} {
            if {[catch {set token [::http::geturl $url -timeout 5000]} err]} {
                if {$i == 5} {
                    ::http::unregister https
                    send_youtube_message $chan "Erreur HTTP après 5 tentatives : $err"
                    return ""
                }
                after 1000
                continue
            }
            if {[::http::status $token] eq "ok"} { break }
            set err_msg [::http::error $token]
            switch -exact [::http::ncode $token] {
                429 {
                    send_youtube_message $chan "Erreur : Limite de requêtes atteinte, réessayez plus tard."
                    ::http::cleanup $token
                    ::http::unregister https
                    return ""
                }
                403 {
                    set raw_response [::http::data $token]
                    putlog "Erreur YouTube API (HTTP 403): $raw_response"
                    ::http::cleanup $token
                    ::http::unregister https
                    send_youtube_message $chan "Erreur : Vidéo privée ou restrictions activées."
                    return ""
                }
                404 {
                    set raw_response [::http::data $token]
                    putlog "Erreur YouTube API (HTTP 404): $raw_response"
                    ::http::cleanup $token
                    ::http::unregister https
                    send_youtube_message $chan "Erreur : Vidéo supprimée ou introuvable."
                    return ""
                }
            }
            ::http::cleanup $token
            if {$i == 5} {
                ::http::unregister https
                send_youtube_message $chan "Erreur HTTP après 5 tentatives : $err_msg"
                return ""
            }
            after 1000
        }
        set data [::http::data $token]
        ::http::cleanup $token
        ::http::unregister https
        if {[string trim $data] eq ""} {
            send_youtube_message $chan "Erreur : Réponse vide de l’API"
            return ""
        }
        if {[catch {set json_data [::json::json2dict $data]} err]} {
            send_youtube_message $chan "Erreur JSON : $err"
            return ""
        }
        return $json_data
    }

    # Procédure pour récupérer les données de chaîne depuis l'API YouTube
    proc fetch_channel_data {url chan type} {
        set json_data [fetch_youtube_data $url $chan]
        if {$json_data eq ""} {
            return ""
        }
        if {![dict exists $json_data items] || [llength [dict get $json_data items]] == 0} {
            return ""
        }
        return [lindex [dict get $json_data items] 0]
    }

    # Procédure pour formater un message YouTube
    proc format_yt_message {parts {separator "|"}} {
        set message ""
        set first 1
        foreach part $parts {
            if {$first} {
                append message "\002$part\002 "
                set first 0
            } else {
                append message "\00304${separator}\003 $part"
            }
        }
        append message " \00304${separator}\003"
        return [string trim $message]
    }

    # Procédure pour rechercher des vidéos YouTube
    proc search_youtube {nick chan query} {
        variable api_key
        upvar #0 ::youtube::title title
        upvar #0 ::youtube::video_id video_id
        set formatted_query [url_encode $query]
        set url "https://www.googleapis.com/youtube/v3/search?part=snippet&q=$formatted_query&type=video&key=$api_key"
        set json_data [fetch_youtube_data $url $chan]
        if {$json_data eq ""} { 
            error "Échec de la recherche"
        }
        set video [lindex [dict get $json_data items] 0]
        if {![dict exists $video id] || ![dict exists $video snippet]} { 
            error "Aucune vidéo trouvée pour cette recherche"
        }
        set id_dict [dict get $video id]
        set snippet_dict [dict get $video snippet]
        if {![dict exists $id_dict videoId] || ![dict exists $snippet_dict title]} { 
            error "ID ou titre manquant"
        }
        set title [clean_title [dict get $snippet_dict title]]
        set video_id [dict get $id_dict videoId]
    }

    # Procédure pour formater la durée d'une vidéo
    proc format_duration {duration} {
        if {$duration eq "P0D" || $duration eq "PT0S" || $duration eq ""} {
            return "Live"
        }
        if {![regexp {PT(?:(\d+)H)?(?:(\d+)M)?(?:(\d+)S)?} $duration _ hours minutes seconds]} {
            return "En cours de traitement"
        }
        set hours [expr {$hours ne "" ? $hours : 0}]
        set minutes [expr {$minutes ne "" ? $minutes : 0}]
        set seconds [expr {$seconds ne "" ? $seconds : 0}]
        if {$hours > 0} { return "${hours}h ${minutes}mn ${seconds}s" }
        if {$minutes > 0} { return "${minutes}mn ${seconds}s" }
        return "${seconds}s"
    }

    # Procédure pour formater le nombre de vues d'une vidéo
    proc format_views {views} {
        if {![string is integer -strict $views]} { return "N/A" }
        if {$views >= 1000000} { return [format "%.1fM" [expr {$views / 1000000.0}]] }
        if {$views >= 1000} { return [format "%.1fK" [expr {$views / 1000.0}]] }
        return $views
    }

    # Procédure pour formater la date de publication
    proc format_published_date {published_at} {
        regsub {\.\d+Z$} $published_at "Z" clean_date
        if {[catch {set timestamp [clock scan $clean_date -format "%Y-%m-%dT%H:%M:%SZ"]} err]} {
            return "Date inconnue"
        }
        return [clock format $timestamp -format "%d-%m-%Y"]
    }

    # Procédure pour traiter l'URL d'une vidéo YouTube
    proc process_youtube_url {nick chan id text {source ""} {include_link 1}} {
        variable api_key
        upvar #0 ::youtube::title title
        upvar #0 ::youtube::channel_title channel_title
        upvar #0 ::youtube::duration duration
        upvar #0 ::youtube::views views
        upvar #0 ::youtube::published_at published_at
        upvar #0 ::youtube::video_link video_link
        set title ""
        set channel_title ""
        set duration ""
        set views ""
        set published_at ""
        set video_link ""
 
        set url "https://www.googleapis.com/youtube/v3/videos?part=snippet,contentDetails,statistics&id=$id&key=$api_key"
        set video [fetch_channel_data $url $chan "Vidéo"]
        if {$video eq ""} { 
            send_youtube_message $chan "Erreur : Vidéo invalide ou introuvable"
            return
        }
        set title [clean_title [dict get $video snippet title]]
        set channel_title [clean_title [dict get $video snippet channelTitle]]
        set raw_duration [dict get $video contentDetails duration]
        set duration [expr {$raw_duration eq "P0D" ? "Live" : [format_duration $raw_duration]}]
        set views [format_views [dict get $video statistics viewCount]]
        set published_at [format_published_date [dict get $video snippet publishedAt]]
        set video_link "https://youtu.be/$id"
    }

    # Initialisation
    init
}

erreur dans tcl

Mon, 23 Dec 2024 04:10:37 +0000

Je ne sais pas quelle pourrait être l'erreur, aidez-moi s'il vous plaît.
en partyline me sale este error
[01:23:25] Tcl error [changeguest]: illegal channel: *

tcl

bind nick - * changeguest
proc changeguest {nick uhost hand chan newnick} {
  global botnick ayudaguest
if {[matchattr $hand mnofb|mnofb $chan] || [isop $nick $chan] || [isvoice $nick $chan] || [ishalfop $nick $chan] && ($nick != $::botnick)} { return 0 }
  foreach guest $ayudaguest {
if {[string match -nocase $guest $newnick]} {
  puthelp "PRIVMSG $chan :Si vous souhaitez utiliser un pseudo, tapez ceci /nick your-nick example /nick ralf et arrêtez d'être un invité."
break ;
}
}
}

MODERATION: Deuxième avertissement ... merci de ne pas copier/coller d'un site mettant de la coloration syntaxique.

aide dans les anti-caps TCL

Wed, 11 Dec 2024 03:22:59 +0000

Je voulais modifier le tcl en ajoutant un chemin au code où, par exemple, il ignore l'utilisation de : or ;

tcl

# caps.tcl

# set bot user flags to ignore text
set vCapsFlagsAllow fo

# set text length (excluding spaces) to allow without checking
set vCapsLengthAllow 8

# set maximum percentage caps allowed (calculation excludes spaces in text)
# greater than 0, less than or equal to 100
set vCapsPercentAllow 90

# set number of warnings before punishing
# integer value equal to or greater than 1
set vCapsWarnings 3

# set here the mode of punishment
# 1 == kick only (after warnings)
# 2 == kickban (after warnings)
set vCapsPunishMode 1

# time in minutes within which a warning remains valid
# even after the user is punished, passed offences remain valid for this time period
# hence a user could be punished twice for two consecutive offences
set vCapsSinTime 20

# if punishment mode 2, set here the time in minutes the ban lasts
set vCapsBanTime 10

# Set this to 1 to ignore nicks in lines
set vIgnoreNick 1
 
proc ldiff {list1 list2 {option -exact}} {
   if {$option ne "-nocase"} { set option -exact }
   return [lmap x $list1 {expr {[lsearch $option $list2 $x] < 0 ? $x : [continue]}}]
}
 
proc ctcp_capslock {nick uhost hand chan keyword arg} {
   pCapsDetect $nick $uhost $hand $chan $arg
}
 
bind PUBM - * pCapsDetect
 
proc pCapsDetect {nick uhost hand chan text} {
   global vCapsBanTime vCapsFlagsAllow vCapsLengthAllow vCapsPercentAllow
   global vCapsPunishMode vCapsSinBin vCapsSinTime vCapsWarnings
 
   if {[isbotnick $chan] || [string match -nocase "*:*" $text] || [string match -nocase "*;*" $text]} { return 0 }
   if {[botisop $chan]} {
      if {![matchattr [nick2hand $nick] $vCapsFlagsAllow $chan]} {
         if {$::vIgnoreNick == 1} {
            set nicks [split [chanlist $chan]]
            set text [join [ldiff [split $text] $nicks]]
         }
         set caps [regexp -all -- {[A-Z]} $text]
         set total [string length [regsub -all -- {[\s]} $text {}]]
         if {$total > $vCapsLengthAllow} {
            set percent [expr {$caps * 100.0 / $total}]
            if {$percent > $vCapsPercentAllow} {
               set now [unixtime]
               set max [expr {$now - ($vCapsSinTime * 60)}]
               lappend vCapsSinBin(${nick},$chan) $now
               foreach sin $vCapsSinBin(${nick},$chan) {
                  if {$sin >= $max} {lappend newlist $sin}
               }
               set vCapsSinBin(${nick},$chan) $newlist
               if {[llength $vCapsSinBin(${nick},$chan)] > $vCapsWarnings} {
                  switch -- $vCapsPunishMode {
                     1 {}
                     2 {
                        pushmode $chan +b ${nick}!$uhost
                        flushmode $chan
                        timer $vCapsBanTime [list pushmode $chan -b ${nick}!$uhost]
                     }
                     default {return 0}
                  }
                  putkick $chan $nick "excess caps, you were warned"
               } else {
                  set output "*** [llength $vCapsSinBin(${nick},$chan)] WARNING(S) *** within the last $vCapsSinTime minutes for excess caps"
                  putserv "PRIVMSG $chan :$nick $output"
               }
            }
         }
      }
   }
   return 0
}

# eof

Modération: merci de ne pas copier/coller d'un site mettant de la coloration syntaxique

Amélioration d'un script pour le rendre plus performant

Thu, 26 Sep 2024 15:57:32 +0000

Hello à tous,

j'ai besoin d'optimiser un script pour le rendre plus performant :

tcl

# Regexp connection user 
set ::checkpays::regexpclientco {:\ (.*)\ \((.*?)@(.*?)\) \[(.*?)\] \[vhost: (.*?)\] (.*)\ \[country: (.*?)\] \[asn: (.*?)\] \[asname: (.*?)\] \[reputation: (.*?)\] (.+)}

# Realname age sexe
set ::checkpays::regexpagesex {^\d{1,2} [HFM]( .+)?}

# regexp pour match les ados de 12 à 17ans
set ::checkpays::regexpado {(1[2-7]) (H|F|M)}

############################################
#        PROC TRAITEMENT CONNECTING        #
############################################
 
proc ::checkpays::who:co {from keyword text} {
 
	if {![string match -nocase "*Client connecting*" $text]} {
		return;
	}
 
	set sslco 0
	set webirc 0
	set websocket 0
	set unknow 0
	set account 0
 
	regexp $::checkpays::regexpclientco $text - nick username ip ipdns vhost csa codepays asn asname reputation other

	# IP Except
	if {$ip eq "127.0.0.1" || [isbotnick $nick]} {
		return
	}
 
	set SESSION [md5 "${username}@${vhost}"]
 
	if {[string match -nocase "*tls-users*" $other]} {
		set sslco 1
	}
 
	if {[string match -nocase "*webirc-users*" $other]} {
		set webirc 1
	}
 
	if {[string match -nocase "*websocket-users*" $other]} {
		set websocket 1
	}
 
	if {[string match -nocase "*unknown-users*" $other]} {
		set unknow 1
	}
 
	if {[string match -nocase "*account:*" $csa]} {
		set account 1
	}

	# On met en mémoire les valeurs qu'on ne récupère pas dans le who
	set ::checkpays::DB($SESSION,IP) $ip
	set ::checkpays::DB($SESSION,IPDNS) $ipdns
	set ::checkpays::DB($SESSION,CODEPAYS) $codepays
	set ::checkpays::DB($SESSION,ASN) $asn
	set ::checkpays::DB($SESSION,ASNAME) $asname
	set ::checkpays::DB($SESSION,REPUTATION) $reputation
	set ::checkpays::DB($SESSION,SSLCO) $sslco
	set ::checkpays::DB($SESSION,WEBIRC) $webirc
	set ::checkpays::DB($SESSION,WEBSOCKET) $websocket
	set ::checkpays::DB($SESSION,UNKNOW) $unknow
	set ::checkpays::DB($SESSION,ACCOUNT) $account
 
	putnow "WHO $nick %unhr"
 
}
 
proc ::checkpays::who:gestion {from key text} {
 
   	set text [split [string trim $text]]
	lassign $text {} username vhost nick
	set SESSION [md5 "${username}@${vhost}"]
	set realname [join [lrange [split $text {:}] 1 end]]

	## On recupere les variables en mémoire
	set ip $::checkpays::DB($SESSION,IP)
	set ipdns $::checkpays::DB($SESSION,IPDNS)
	set sslco $::checkpays::DB($SESSION,SSLCO)
	set webirc $::checkpays::DB($SESSION,WEBIRC)
	set websocket $::checkpays::DB($SESSION,WEBSOCKET)
	set reputation $::checkpays::DB($SESSION,REPUTATION)
	set codepays $::checkpays::DB($SESSION,CODEPAYS)
	set asn $::checkpays::DB($SESSION,ASN)
	set asname $::checkpays::DB($SESSION,ASNAME)
	set unknow $::checkpays::DB($SESSION,UNKNOW)
	set account $::checkpays::DB($SESSION,ACCOUNT)

	# Nick/Ip/Ident EXCEPTION
	if {[::toolsAmand::verify:b $::checkpays::fichier(ident) $username]} {
 
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,3EXCEPTION - IDENT\003\002 \002\[\002$codepays\002\]\002 - $nick ($username@$ip) (Réputation: $reputation) (Sslco: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
		::checkpays::monitoring $nick $username $ip $vhost $codepays $reputation $sslco $webirc $websocket $realname $asn $asname
		::checkpays::CountIRC $ip $username $codepays $webirc $websocket
		return
 
	} elseif {[::toolsAmand::verify:b $::checkpays::fichier(pseudo) $nick]} {
 
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,3EXCEPTION - PSEUDO\003\002 \002\[\002$codepays\002\]\002 - $nick ($username@$ip) (Réputation: $reputation) (Sslco: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
		::checkpays::monitoring $nick $username $ip $vhost $codepays $reputation $sslco $webirc $websocket $realname $asn $asname
		::checkpays::CountIRC $ip $username $codepays $webirc $websocket
		return
 
	} elseif {[::toolsAmand::verify:b $::checkpays::fichier(ip) $ip]} {
 
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,3EXCEPTION - IP\003\002 \002\[\002$codepays\002\]\002 - $nick ($username@$ip) (Réputation: $reputation) (Sslco: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
		::checkpays::monitoring $nick $username $ip $vhost $codepays $reputation $sslco $webirc $websocket $realname $asn $asname
		::checkpays::CountIRC $ip $username $codepays $webirc $websocket
		return
 
	} else {
 
	}

	# On envoie à la proc de traitement
	::checkpays::traitement $nick $username $ip $ipdns $vhost $codepays $asn $asname $reputation $sslco $webirc $websocket $unknow $realname $account

	# Changement du realname en ASV / Redirection ados
	if {[regexp $::checkpays::regexpagesex $realname] != 1} {
 
		putnow "CHGNAME $nick [expr 18 + int(rand()*72)] M"
		putnow "PRIVMSG $::checkpays::backpaysredirect :\002\00300,02REALNAME\003\002 - \002$nick\002 \[$codepays\] ($username@$ip) (Réputation: $reputation) (Ssl: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Account: $account) (Asn: $asn) (Asname: $asname) vient d'être changé. Realname: $realname"
 
	} elseif {[regexp $::checkpays::regexpado $realname] == 1} {
 
		putnow "PRIVMSG OperServ :SVSJOIN $nick $::checkpays::salonado"
		putnow "SAUMODE $nick +R"
		#putnow "PRIVMSG $::checkpays::backpaysredirect :\002\0030,6ADO\002\003 - \002$nick\002 ($username@$ip) a été redirigé sur \002$::checkpays::salonado\002 - \002Realname:\002 $realname"
 
	} else {
 
	}
 
}
 
proc ::checkpays::traitement {nick username ip ipdns vhost codepays asn asname reputation sslco webirc websocket unknow realname account} {
 
	set SESSION [md5 "${username}@${vhost}"]
	set ALLEXCEPTIONS [list {*}$::checkpays::PAYSINTERDIT {*}$::checkpays::PAYSINTERDITNWSI {*}$::checkpays::PAYSINTERDITNW {*}$::checkpays::PAYSIPAPI {*}$::checkpays::PAYSEXCEPTION]
	set sanction 0

 
	# IP-API

	# Bloquer IPAPI Proxy/Hosting - IPABUSEIPDB
	if {[lsearch $::checkpays::PAYSIPAPI $codepays]!=-1} {
		::checkpays::infoAPI $nick $username $ip $ipdns $unknow $reputation $realname $webirc $websocket $account
	}

	# Traitement
	if {[lsearch $::checkpays::PAYSINTERDIT $codepays] != -1} {
 
		set sanction 1
		putnow "GLINE *@$ip $::checkpays::timeBans $::checkpays::motifpaysbl"
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,4PAYS BLOQUÉ\003\002 \[\002$codepays\002\] - \002$nick\002 ($username@$ip) (Réputation: $reputation) (Ssl: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
 
	} elseif {([lsearch $::checkpays::PAYSINTERDITNWSI $codepays] != -1) && ($webirc == 0) && ($websocket == 0) && ($reputation < 200)} {
 
		set sanction 1
		putnow "GLINE *@$ip $::checkpays::timeBans $::checkpays::motifpaysbl"
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,12PAYS BLOQUÉ - HORS WEB|RÉPUTATION\003\002 \[\002$codepays\002\] - \002$nick\002 ($username@$ip) (Réputation: $reputation) (Ssl: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
 
	} elseif {([lsearch $::checkpays::PAYSINTERDITNW $codepays] != -1) && ($webirc == 0) && ($websocket == 0)} {
 
		set sanction 1
		putnow "GLINE *@$ip $::checkpays::timeBans $::checkpays::motifpaysbl"
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,6PAYS BLOQUÉ - HORS WEB\003\002 \[\002$codepays\002\] - \002$nick\002 ($username@$ip) (Réputation: $reputation) (Ssl: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
 
	} elseif {($codepays eq "US") || ([string match "*.irccloud.com" $ip])} {
 
		set sanction 1
		putnow "GLINE $username@$ip $::checkpays::timeBans $::checkpays::motifpaysbl"
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,10IRCCloud|US\003\002 \[\002$codepays\002\] - \002$nick\002 ($username@$ip) (Réputation: $reputation) (Ssl: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
 
	} else {
 
		# Si on entre pas dans une condition blacklisté on envoie à la proc du monitoring
		::checkpays::monitoring $nick $username $ip $vhost $codepays $reputation $sslco $webirc $websocket $realname $asn $asname
		::checkpays::CountIRC $ip $username $codepays $webirc $websocket
 
	}

	# Vérification si le codepays est hors liste interdit/protégé
	if {[lsearch $ALLEXCEPTIONS $codepays]==-1} {
		putnow "PRIVMSG $::checkpays::backpaysbl :\002\0030,14USER SUSPECT\003\002 \[\002$codepays\002\] - \002$nick\002 ($username@$ip) (Réputation: $reputation) (Ssl: $sslco) (Webirc: $webirc) (Websocket: $websocket) (Asn: $asn) (Asname: $asname) - Realname: $realname"
		::checkpays::infoAPI $nick $username $ip $ipdns $unknow $reputation $realname $webirc $websocket $account
		::checkpays::infoABUSEIPDB $nick $username $ipdns
	}

	# Suppression des valeurs en mémoire.
	# https://www.astro.princeton.edu/~rhl/Tcl-Tk_docs/tcl/unset.n.html
	unset ::checkpays::DB($SESSION,IP)
	unset ::checkpays::DB($SESSION,IPDNS)
	unset ::checkpays::DB($SESSION,REPUTATION)
	unset ::checkpays::DB($SESSION,SSLCO)
	unset ::checkpays::DB($SESSION,WEBIRC)
	unset ::checkpays::DB($SESSION,CODEPAYS)
	unset ::checkpays::DB($SESSION,WEBSOCKET)
	unset ::checkpays::DB($SESSION,ASN)
	unset ::checkpays::DB($SESSION,ASNAME)
	unset ::checkpays::DB($SESSION,UNKNOW)
	unset ::checkpays::DB($SESSION,ACCOUNT)
 
	if {$sanction == 1} {
		return
	}
 
}

Il manque des variables/fonctions, j'ai mis les lignes essentiels pour faire un focus sur la problématique et de la partie qui doit être optimiser.

Il est fonctionnel, mais je pense qu'on peut faire largement mieux pour le rendre plus fluide , si vous avez des idées, welcome.

Code TCL pour ban HOST + IDENT

Tue, 30 Jul 2024 09:16:11 +0000

Bonjour,

Je laisse un message pour une aide concernant mon tcl
Il bannit bien l'host, mais, je cherche a bannir l'ident également sous forme : *!blabla@*
Dans ce que je vais vous mettre ci-dessous, il bannit mon propre ident.

tcl

bind pub - !kbapp kbapp
proc kbapp {nick uhost handle chan args} {
  if {![isop $nick $chan] && ![ishalfop $nick $chan]} { putquick "NOTICE $nick tu n'as pas accés à cette commande"; return 0}
  if {[lindex $args 0]!=""} {
      set vnick [lindex $args 0]
      if {![onchan $vnick $chan]} { putquick "NOTICE $nick :\00312 [Erreur] $vnick n'est pas sur $chan"; return 0}
      set vhost [lindex [split [getchanhost $vnick $chan] "@"] 1]
  set uident [string trimleft [lindex [split $uhost "@"] 0]]
  putserv "MODE $chan +b *!$uident@*"
      putquick "PRIVMSG chanserv ban $chan $vnick Pas de pub pour les applications. ($nick)"
  putquick "PRIVMSG BOTSERV say $chan Info: $vnick est banni(e) de $chan pour la raison suivante: Publicité Interdite. (Par $nick)"
  putquick "PRIVMSG #Back-Tentation KickBan Applications Pseudo: $vnick sur $chan par $nick"
  return
  } else {
      puthelp "NOTICE $nick Pseudo Incorrecte"
      return
  }

}

Si quelqu'un trouve l'erreur ou veut bien m'aider/guider..
Merci d'avance !

Subtilité de matchattr

Tue, 28 May 2024 06:24:42 +0000

Hello :)

J'ai découvert il y a peu de temps une petite subtilité de matchattr qui pourrait s'avérer gênante si on y prend pas garde.
On m'avait demandé un script qui doit agir si la personne n'a pas d'accès halfop (ou plus) sur un canal (ou de manière globale).
Il y avait donc dans la procédure:

tcl

if {[matchattr $handle -l&-l $chan]} {

Donc en toute logique, on s'attend à obtenir 1 si la personne n'a ni d'accès halfop sur l'eggdrop ni sur le canal visé.

Sauf que... Si l'utilisateur est inconnu ($handle *), la procédure matchattr retourne 0, donc pour le script cette personne a un accès.

Il faut donc toujours vérifier que l'utilisateur existe lorsqu'on travaille avec des absences de flags:

tcl

if {$handle ne "*" && [matchattr $handle -l&-l $chan]} {

J'ai ouvert une issue et proposé une PR pour que matchattr retourne -1 plutôt que 0 si l'utilisateur est inconnu.

Module MySQL

Wed, 01 May 2024 13:27:02 +0000

Michael Ortmann a adapté le module MySQL (initialement créé par BarkerJr) pour pouvoir utiliser MySQL sans avoir à charger le package TCL.

Pour l'installer
Pré-requis: libmysqlclient-dev

Téléchargez le module depuis nos scripts ou sur le github
Placez le dans ~/eggdrop-1.9.5/src/mod/
Décompressez le module
Recompilez eggdrop (cd ~/eggdrop-1.9.5/ & ./configure & make config & make & make install)
Ajoutez loadmodule mysql à votre fichier .conf
Rehashez l'eggdrop

Commandes accessibles en TCL

mysql_connect [user] [password] [socket|port]
mysql_close
mysql_query
mysql_escape [byte]
mysql_errno
mysql_ping
mysql_connectioninfo
mysql_insert_id
mysql_connected
mysql_affected_rows

VDM

Sun, 25 Feb 2024 15:22:44 +0000

Bonjour à tous et même si en retard une bonne année 2024 (certes déjà bien entamée)

J'ai recherché ces derniers temps le VDM, mais me bug toujours :
"Aucune information identifiable n'a pu être récupérée. Le site rencontre peut-être un problème ou bien le layout du site a changé. VDM."

J'ai regardé les liens et adresses, elels semblent correctes, ou j'

Problème de liste avec une requête sql

Wed, 14 Feb 2024 05:57:02 +0000

J'ai une condition qui fait une requête sql pour retourner une erreur si l'utilisateur a déjà un accès dans un autre channel:

tcl

::certUser::service:connect
set res [mysqlsel $::mysqlink "SELECT count(*),salon FROM `voiceauto` WHERE pseudo='$pseudo'" -list]
putlog "res => $res"
set nb [lindex $res 0]
putlog "nb => $nb"
set otherchan [lindex $res 1]
putlog "otherchan => $otherchan"
::certUser::service:deconnect

J'ai un problème pour récupérer les lindex, le putlog me retourne :

Citation :[06:52:03] res => {1 #test}
[06:52:03] nb => 1 #test
[06:52:03] otherchan =>

normalement $nb devrait me retourner 1 et $otherchan #test

fonction channel get

Wed, 14 Feb 2024 05:47:17 +0000

Hello à tous,

j'ai fait une procédure :

tcl

bind msg o|o addc ::certUser::addc
proc ::certUser::addc { nick host hand arg } {
 
set pseudo [lindex $arg 0]
set chan [lindex $arg 1]
 
if {![channel get $chan cert]} {
return
}
 
...
 
}

quand j'écris un chan qui n'est pas en mode cert, le bot me retourne :

[06:33:13] Tcl error [::certUser::addc]: no such channel record

Normalement, il devrait faire un return, quand le channel mis dans la cmds n'a pas le mode ?

Ou ça veut dire que le channel n'existe pas auprès de l'eggdrop du coup il ne peut pas vérifier si le channel a le mode ou pas?

subtilités de getaccount

Thu, 08 Feb 2024 10:29:24 +0000

Pour faire suite au souci sur isidentified, nous avons poussé les tests.

Résumé du problème: un utilisateur identifié rejoint le canal, le getaccount renvoie la bonne valeur. Si l'utilisateur s'identifie après être entré, getaccount retourne *

Tests:

tcl

bind account - * accountuser
proc accountuser {nick uhost hand chan {account ""}} {
   putlog "*** account => $account vs [getaccount $nick $chan]"
   principale $nick $uhost $chan
}
proc principale {nick uhost chan} {
   putlog "*** principale => getaccount $nick $chan = [getaccount $nick $chan]"
   return
}

Code :
[10:56] test0r!toto@toto.vhost.fr has logged out of their account

[10:56] *** account => * vs toto

[10:56] *** principale => getaccount test0r #test = toto

[10:56] test0r!toto@toto.vhost.fr logged in to their account toto

[10:56] *** account => toto vs *

[10:56] *** principale => getaccount test0r #test = *

Ce que l'on voit, c'est que getaccount retourne le compte de la personne ayant déclenché le bind en non pas le compte après l'identification (ou le logout). Par contre, l'argument $account est bien le nouveau.

Cela signifie que si vous avez une procédure qui doit réagir à une (dés)identification et travailler avec le nouveau compte, vous ne devez pas utiliser getaccount mais $account.

Fonction isidentified

Wed, 07 Feb 2024 21:12:49 +0000

J'ai une condition dans une procédure qui doit s'effectuer quand l'utilisateur est identifié auprès de NickServ:

tcl

bind join - * [namespace current]::joincertif
proc joincertif { nick host hand chan } {
 
lassign [split $host "@"] ident uhost
 
putlog "isidentified => $nick = [isidentified $nick]"
 
if {![isidentified $nick] || [isvoice $nick $chan]} { return }
 
::certUser::service:connect
set res [mysqlsel $::mysqlink "SELECT count(*) FROM `voiceauto` WHERE pseudo='$nick' and salon='$chan'" -list]
set nb [lindex $res 0]
if {$nb >= 1} {
putserv "PRIVMSG ChanServ voice $chan $nick"
}
::certUser::service:deconnect
 
}

La problématique est que la fonction isidentified renvoie 1 même quand l'user est présent sur le canal et qu'il n'est pas identifié ou register.