Script para Eggdrop que detecta patrones de expresiones regulares en mensajes y actions enviados al canal

badregex.tcl

# Regex detector
# by Atlas (@xatlas) on 07/Oct/14
# You can do with this script what you want

# Regex protip: on tcl \b is \y, and \B is \Y
# http://www.regular-expressions.info/wordboundaries.html

# Updated: 04/Nov/15: \s+ -> \s
# Published on Github: 05/Nov/17

# Settings

# Number of minutes of ban
set bregex_bantime "180"

# Kick reason
set bregex_kickreason "\[Auto\] Actividad no permitida en el canal"

# Channel to send notifications
set bregex_chanops "#canal"

# Regular expressions, put between {regex}
set bregex_list {
  {^(?!.*(youtube|spotify|vimeo|chathispano|wikipedia|terra|wstats|forocoches)).*\w{3,}\.(com|net|org|e[us]|t[kov]|l[iy]|gl|xyz)\y}
  {^Mi C.*mara Web en Directo Gratis$}
  {\ymi kik\y}
}

setudef flag badregex

bind pub nmo|nmo .regex bregex_settings
bind pubm - * bregex_main
bind ctcp - ACTION bregex_action

proc bregex_main {nick uhost hand chan text} {
  global bregex_bantime bregex_kickreason bregex_chanops
  if {![channel get $chan badregex]} {return}
  if {![botisop $chan]} {return}
  if {[isop $nick $chan] || [isvoice $nick $chan]} {return}

  set bregex_badstring [bregex_parser $text]

  if {$bregex_badstring ne 0} {
    set bregex_banhost [bregex_ipv $nick $uhost]
    set bregex_debug [regexp {^(\d+):(.*)} $bregex_badstring - bregex_id bregex_badstring]
    newignore $bregex_banhost badregex.tcl Ignore-flood 1
    putquick "MODE $chan +b $bregex_banhost"
    puthelp "KICK $chan $nick :\[Auto\] $bregex_kickreason"
    if {$bregex_chanops ne ""} {
      puthelp "PRIVMSG $bregex_chanops :\002\[RE $bregex_id\]\002 Caneando a \002$nick\002 ($uhost) en $chan por: [string range $text 0 200]"
    }
    putlog "\[\002RegEx ID: $bregex_id\002\] $nick ($uhost) @ $chan enviando \"$text\" /$bregex_badstring/"
    return
  }
}

# Magic goes here
proc bregex_parser {str} {
  global bregex_list
  regsub -all -nocase { +} $str { } str
  regsub -all -nocase {[\u00e0-\u00e5]} $str {a} str
  regsub -all -nocase {[\u00e8-\u00eb]} $str {e} str
  regsub -all -nocase {[\u00ec-\u00ef]} $str {i} str
  regsub -all -nocase {[\u00f2-\u00f8]} $str {o} str
  regsub -all -nocase {[\u00f9-\u00fc]} $str {u} str
  set bregex_id 0
  foreach bregex_re $bregex_list {
    incr bregex_id
    if {[regexp -nocase -lineanchor $bregex_re $str]} {
      return $bregex_id:$bregex_re
    }
  }
  return 0
}


# Special proc for ChatHispano network
# Bans nick instead personal vhost
proc bregex_ipv {n u} {
  if {![regexp {[^@]+@[A-D][A-z0-9]{5}\.[A-D][A-z0-9]{5}\.v(irtual|6)} $u]} {
    return "$n!*@*"
  } else {
    return "*!*[string range $u [string first "@" $u] end]"
  }
}

# Catch ctcp actions and process as chan msg
proc bregex_action {nick uhost hand dest key text} {
  bregex_main $nick $uhost $hand $dest $text
}


# Enabler/disabler of script on channel
proc bregex_settings {nick uhost hand chan text} {
  set status [channel get $chan badregex]
  set mode [string tolower [lindex [split $text] 0]]
  switch -- $mode {
    "on" {
      if {!$status} {
        channel set $chan +badregex
        puthelp "PRIVMSG $chan :\002\0031,0 BadRegex \003\002 - Enabled"
        putlog "BadRegex script enabled (by $nick for $chan)"
      } else {
        puthelp "NOTICE $nick :BadRegex is already activated"
      }
    }
    "off" {
      if {$status} {
        channel set $chan -badregex
        puthelp "PRIVMSG $chan :\002\0031,0 BadRegex \003\002 - Disabled"
        putlog "BadRegex script disabled (by $nick for $chan)"
      } else {
        puthelp "NOTICE $nick :BadRegex is already deactivated"
      }
    }
  }
}

putlog "Badregex script loaded"