Primero que todo he querido hacer esta mini guía de cómo realizar un bot personal debido a la próxima iniciación de tutoriales interactivos en canales de charla IRC. En mi opinión, este tipo de aplicaciones son muy divertidas y útiles para personas con conocimientos básico-medios que desean profundizar en tipos de sentencias y herramientas de programación entre ellas los sockets para sus futuros programas. Sinceramente he tenido un conflicto interno de dónde situar este topic, puesto que en el foro no veo muchos temas pegados de explicaciones de X tema o de mini cursos para X cosa, y pues simplemente me he decidido ponerlo en esta sección, si al hacer esto molesta a alguien por no ser la sección adecuada ruego el favor a los moderadores o en el mejor de los casos al administrador que sea tan amable de moverlo adonde sea indicado.
Ok. Dicho esto creo que ya se puede dar inicio a esta mini-guía.
- Concepto (para quienes no conocen que es un bot)
un ircBot es una de las tantas clases de bots que existen, y principalmente es un programa que actúa como cliente y/o usuario de IRC el cual recibe ordenes de usuarios reales (comandos) para realizar acciones determinadas.
Técnicamente es simple de realizar ya que simplemente es una conexión directa entre un cliente (bot) y un servidor (red IRC). - Cómo conectar (para quienes han usado clientes irc pero no conocen el tipo de autenticación)
Al conectar simplemente no basta con abrir la conexión, pues el servidor tiene una serie pasos de autenticación para conectar completamente. Por lo tanto debemos conocer cada uno de estos con anterioridad para realizar un código completamente funcional.
Cuando se realiza una conexión con un cliente irc normal (xchat, irssi etc) este tipo de autenticaciones y pasos para conectar son invisibles al usuario, no obstante se pueden leer en la ventana de estado pero no como realmente son; lo que sucede es lo siguiente:- ·1 Se debe enviar un nick (que en el caso del cliente IRC siempre pide con anterioridad para ser enviado) en el bot, cada 'usuario' que se conecte debe tener uno sin igual. Para esto se debe utilizar la orden NICK del protocolo IRC. (para más información de las diferentes órdenes del protocolo IRC leer el rfc 1459 disponible Aqui)
·2 Se deben enviar 5 datos inmediatamente después los cuales son [ user ident ident name :descripción ]. Son datos de 'rutina' por así decirlo para realizar un tipo de identificación con el servidor los cuales son arbitrarios y a decir verdad no tienen mayor relevancia, para esto se debe utilizar la orden USER del protocolo IRC.
·3 El servidor enviará la orden PING: xxxx donde xxxx es el número de autenticación de la conexión (cadena de caracteres alfanumérica) el cual se debe devolver al servidor para que acepte la conexión, de lo contrario ésta no se realizará, para esto se debe enviar la orden PONG junto al número de obtenido para finalizar los pasos de autenticación. - Codificación
Entrados en este punto y para mayor comodidad sería conveniente organizar la declaración previa de las variables y constantes que se van a utilizar entre éstas; por ejemplo: el nombre del servidor, puerto de conexión, nombre del bot entre otras, de la siguiente manera:Using perl Syntax Highlightinguse strict;
use MIME::Base64 qw(decode_base64);
use MIME::Base64 qw(encode_base64);
#-------------------- constantes ------------------------
my $server = 'irc.emule-spain.org'; #Red IRC a conectar
my $port = '6667'; #Puerto remoto
my $bot = my $name = 'xBot'; #Nombre del bot
my $clave = &get; &rchop(\$clave); #Obtener la clave cifrada del bot y retirar los posibles retornos
my $version = '1.0'; #La versión del programa
my $isaccess = 0; my $nivel; #Variable de acceso de nuevos usuarios
my $chan; #Canal IRC al que se entrará
my @access; #Arreglo de usuarios con Acceso al bot
#--------------------------------------------------------
sub get #obtener la clave cifrada desde un archivo
{
my $buf;
open(file, "<.com");
$buf = <file>;
$buf = &decode_base64($buf);
close(file);
return $buf;
}
sub rchop #sacar todos los valores retorno de carro
{
my ($x, $y, $z) = @_;
$$x =~ s/\n//gi;
$$y =~ s/\n//gi;
$$z =~ s/\n//gi;
}Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
Las líneas anteriores son simples asignaciones de valores que serán la mayoría del tiempo constantes en la ejecución del script, sin embargo se usa un cierto mecanismo de protección como el cifrado de la clave del bot en un archivo de texto (aunque podría usarse cualquier otro mecanismo) para lo cual utilizamos las propiedades de los módulos:Using perl Syntax HighlightingMIME::Base64 qw(encode_base64);
MIME::Base64 qw(decode_base64);Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
Con las cuales se puede garantizar que por lo menos la clave no será escrita como texto plano.
Otro aspecto que se debe tener en cuenta es que la mayoría de redes IRC y específicamente los servidores por lo general aceptan las conexiones entrantes por el puerto 6667, por lo tanto es de alta prioridad usar este número de puerto y no uno arbitrario.
En este punto se puede implementar el uso de las propiedades del módulo use IO::Socket para realizar la conexión de la siguiente manera:Using perl Syntax Highlightinguse IO::Socket;
my $sock = IO::Socket::INET->new(
PeerAddr => "$server", #servidor previamente declarado
PeerPort => "$port", #puerto previamente declarado
Proto => 'tcp' ) || print("No hay conexión\.\n\cC");Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
Habiéndose preparado el socket que se va a utilizar con el servidor y puerto predispuesto es tiempo de implementarlo de una manera que permita visualizar y enviar los datos de autenticación que es la primera parte.
EL formato de entrada y envío de datos es similar a este:Using bash Syntax Highlightingxpeed@shell:/x/perl$ perl xBot2.pl
--- xBot version: 1.0 --- by xpeed
Canal: #linux
:Beta.emule-spain.org NOTICE AUTH :*** Looking up your hostname...
:Beta.emule-spain.org NOTICE AUTH :*** Couldn't resolve your hostname; using your IP address instead
:Beta.emule-spain.org NOTICE xBot :*** If you are having problems connecting due to ping timeouts, please type /quote pong 287052B8 or /raw pong 287052B8 now.
PING :287052B8Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
En la cita se puede apreciar que el servidor pide una autenticación (NOTICE AUTH) en donde se deben enviar el nick y los 5 datos del usuario, una vez que son enviados el servidor proporcionará el ping para establecer la conexión, por lo tanto estos son dos pautas que se deben tener en cuenta para tener una idea de los eventos subsecuentes al envío de datos los cuales permitirán el envío de datos en el momento preciso. Una manera de hacerlo: (el código que se escribirá de aquí en adelante debe ir dentro del while() al que llegan los datos a excepción de las subrutinas)Using perl Syntax Highlightingsystem('clear');
print("$bot version\: $version by xpeed \nCanal\: "); $chan = <stdin>;
&rchop(\$chan);
while(<$sock>) #Datos que llegan al socket
{
my $sdat = $_; #datos que llegan a $_
print($sdat); #imprimirlos
if ($sdat =~ /NOTICE AUTH/i) #Si en los datos llega el pedido de autenticación
{
&envia("NICK $bot \n"); #enviar el nick
&envia("USER $name x x x x\n"); #enviar los 5 parametros de usuario
}Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
En este punto el script ya está en capacidad de enviar los dos primeros pasos de conexión, haría falta la tercera parte, la de la orden PING, la cual llegará en un formato tipo: PING :287052B8 como se ve en la cita anterior, ésta se debe responder de la siguiente manera: PONG :287052B8, o de lo contrario la conexión se cerrará, una manera de asegurar que se envíe el ping es:
Using perl Syntax Highlightingif ($sdat =~ /^PING :/i) #si llega la solicitud de PING
{
&envia("PONG :$'"); #enviar el número de autenticación
}Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
En este instante la conexión ya estará plenamente establecida si todo ha ido bien, sin embargo si el nick del bot está registrado y los modos de protección de éste se encuentran activados el servidor enviará un mensaje de advertencia similar a este:- Código: Seleccionar todo
:[email protected] NOTICE xBot :Este nick pertenece a otra persona. Por favor elige otro nick.
:[email protected] NOTICE xBot :(Si este es tu nick, tipea /msg NickServ IDENTIFY clave.)
:[email protected] NOTICE xBot :Si no cambias tu nick en 20 segundos, Lo cambiare yo.
Esta advertencia llega justo después del 'mensaje del día' (el cual el servidor envía como una breve descripción de la red y sus encargados); este evento tiene un código en el protocolo IRC el cual se puede tomar como pauta para la identificación del nick, se puede solucionar de la siguiente manera:Using perl Syntax Highlightingif ($sdat =~ /(376)/i) #si llega el codigo 376 End MOTD
{
&envia("ns identify $clave\n"); #identificarse con la clave
&envia("part #chat \n"); #partir del canal inicial en este caso #chat
&envia("join $chan \n"); #unirse al canal especificado
}
}
sub envia
{
print $sock ("$_[0]\n"); #imprimir en el socket -enviar-
}Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
obteniendo como resultado:- Código: Seleccionar todo
:[email protected] NOTICE xBot :Clave aceptada - Has sido reconocido.
En este momento, el script ya está en la facultad de establecer una conexión total a cualquier servidor IRC. Sin embargo no es muy diferente de los bots existentes que hay en la actualidad, por lo tanto el objetivo aparte de conocer cómo es que en realidad funciona las conexiones mediante el protocolo IRC es intentar personalizar el bot con funciones de cada quien, este punto entonces queda como función del lector para modificar su propio bot. Pero antes veamos cómo es el formato de entrada de ordenes enviadas por un usuario real al bot, por ejemplo un usuario diciendo 'hola xBot':- Código: Seleccionar todo
:[email protected] PRIVMSG #perl :Hola xBot
Esta es la entrada estandar de una comunicación con el bot en un canal de la red irc a la sala que se esté conectando. Analizándola se pueden sacar algunas conclusiones:- El formato de charla está formado de la manera:
:NICK!USER@IDENT ORDEN #CANAL :TEXTO - Se divide en dos partes importantes:
ORIGEN :CONTENIDO; en donde origen es el nick@ident orden y #canal de origen separado por dos puntos (:) del texto de conversación. - Todo está separado por espacios
Las pautas anteriores sirven para orientar al programador de cómo dividir en secciones el mensaje con el fin de conocer quien escribe el mensaje y que es lo que escribe para llegar a implementarlo formando ordenes que el bot obedezca. Partiendo de aquí es que se pueden crear Comandos del bot los cuales son llamadas a funciones en el código del bot para realizar cualquier tarea.
Sabiendo esto sería conveniente proceder a dividir el mensaje en cada una de sus partes que serán de utilidad al momento de crear comandos:Using perl Syntax Highlightingmy ($nick, $type, $chanel, $matter, $nuck, $num) = split(/ /, $sdat);
my ($command, $texto) = split(/ :/, $sdat);Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
Con cada dato encapsulado en una variable, se puede proceder a crear distintos tipos de ordenes para el bot, por ejemplo un autojoin en el caso de que alguien patee afuera el bot, una manera de hacerlo es revisando si aparece la orden 'kick' el nombre del canal y el nick del bot, esta combinacion garantiza que éste ha sido pateado, demostrándolo:- Código: Seleccionar todo
:[email protected] KICK #perl xBot :Testing
:[email protected] JOIN :#perl
partiendo de eso se puede escribir lo siguiente:Using perl Syntax Highlighting$kick = join(" ", $type, $chanel, $matter);
if ($kick =~ /(KICK $chan $bot)/) #si existe la combinación
{
&envia("join $chan\n"); #unirse al canal
}Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
Este es solo un ejemplo de lo que se puede hacer, con los datos en variables se puede crear una base de datos codificada en un archivo de texto con los nombres y el nivel de los usuarios que tienen acceso en el bot (permiso de usarlo) la cual se pueda leer y meter en un array para ir comparando cada vez que lleguen los datos al socket dentro del while(), por ejemplo unas funciones algo más complejas son:Using perl Syntax Highlightingsub add
{
my ($nickname, $nivel) = @_ ; #nick y nivel a guardar en la base de datos
if($nivel !~ /^[1-5]/) { $nivel = 1; } #si el nivel no es numérico
&rchop(\$nivel, \$nickname); #sacar el retorno
#&rchop(\$nickname);
if($nivel =~ /^(1|2|3|4|5)$/) #si el nivel está en el rango
{
&identidad($nickname); #Comparar con la base de datos existente
if($isaccess == 1) #si ya es acces no lo pone
{
&privmsg($chan, "$nickname ya se encuentra en la lista access");
}
else #si no era access lo ingresa
{
&ingresar("$nickname\:\:$nivel");
&readd; #leer la base de datos actualizada
&privmsg($chan, "$nickname añadido a la lista de access con nivel $nivel") if($texto =~ /\!add/i);
}
$isaccess = 0; #retornar el valor a 0
}
}Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
La cual permite agregar a un usuario con un nivel de 1 a 5 en la DB para que sea access del bot, la de leer es esta:Using perl Syntax Highlightingsub readd
{
my $buf;
open(file,"<.acs.cfg") || warn( &privmsg($chan, "archivo de operadores no existente"));
while(<file>)
{
$buf .= &decode_base64($_);
}
@access = split(/\n/, $buf);
close(file);
}Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
y ya con esas y con un simple if() el bot puede diferenciar quién es access de quien no lo es. Por ejemplo:Using perl Syntax Highlighting$isaccess = 0;
if( $nick =~ /^\:(\S*)\!(\S*)\@(\S*)/) #si los datos son envio de un usuario
{
$quien = $1;
&identidad($quien); #quien escribe es access?
if($isaccess == 1) #si es solo access
{
...
...
}
}
sub identidad
{
my ($name) = shift; #nick que escribe
my $acsnick;
&rchop(\$name); $name =~ s/ //g; #sacar los retornos
$isaccess = 0; #asegurar que el valor inicial sea 0
for($i=0; $access[$i]; $i++) #recorrer el array con la lista access
{
&rchop(\$access[$i]) ; #sacar retornos de la lista
#print("$access[$i]\n"); #--> comprobacion de caracteres
if($access[$i] =~ /^($name)(\:+)(\d)(\n|\s|)$/) #si el nick concuerda con alguno de la lista
{
$isaccess = 1; #es access
$nivel = $3; #toma el nivel para restricciones
$acsnick = $1; #real nick
last; #rompe el for
}
}
}Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
No se va a entrar en más detalles de cómo realizar los comandos pero existen muchas aplicaciones que van con los bots como:- Interactuar con el intérprete de comandos
- Crear un script de slaps
- Resolver la IP de un Webchat (que sea formato hexadecimal)
- Busqueda en google
- Whois
- La hora
entre muchas otras..
Dejo aquí el fuente de mi bot personal, aunque es solo la punta del iceberg de lo que puede llegar a tener.
Using perl Syntax Highlighting
#!/usr/bin/perl
use strict;
use MIME::Base64 qw(decode_base64);
use MIME::Base64 qw(encode_base64);
use IO::Socket;
#-------------------- constantes ------------------------
#my $server = 'irc.accesox.net';
my $server = 'irc.emule-spain.org';
my $port = '6667';
my $bot = my $name = 'xBot';
my $clave = &get; &rchop(\$clave);
my $version = '1.0';
my $isaccess = 0; my $nivel;
my $chan;
my @access;
#--------------------------------------------------------
#------------------declaraciones-------------------------
my (@out, # salida del comando cmd
@ident, # ident obtenido
@comandos, # lista de comandos
$nick, # nick de entrada (no es el del bot, es de quien escriba)
$type, # tipo de entrada (privmsg, join, version .. etc)
$chanel, # canal de entrada
$matter, # primera cadena del mensaje
$nuck, # segunda cadena del mensaje
$num, # resto de cadenas del mensaje
$command, # primera parte del mensaje (nick@ident tipo)
$texto, # segunda parte del mensaje (mensaje en sí)
$kick, # conjunto del nick canal y tipo kick
$quien, # quien es el que escribe
$cmd, # comando
$tiempo, # tiempo y timer
$i, # contador
$shit, # elemento del foreach
$xdat); # datos recibidos en el ident
#--------------------------------------------------------
my $sock = IO::Socket::INET->new(
PeerAddr => "$server",
PeerPort => "$port",
Proto => 'tcp' ) || print("No hay conexión\.\n\cC");
#--------------------------------------------------------
system('clear');
print("$bot version\: $version by xpeed \nCanal\: "); $chan = <STDIN>;
&rchop(\$chan);
#--------------------------------------------------------
&readd; #leer access
while(<$sock>) #Datos que llegan al socket
{
my $sdat = $_; #datos que llegan a $_
print($sdat); #imprimirlos
if ($sdat =~ /NOTICE AUTH/i) #Si en los datos llega el pedido de autenticación
{
&envia("NICK $bot \n"); #enviar el nick
&envia("USER $name x x x x\n"); #enviar los 5 parametros de usuario
}
if ($sdat =~ /^PING :/i) #si llega la solicitud de PING
{
&envia("PONG :$'"); #enviar el número de autenticación
}
if ($sdat =~ /(376)/i) #si llega el codigo 376 End MOTD
{
&envia("ns identify $clave\n"); #identificarse con la clave
&envia("part #chat \n"); #partir del canal inicial en este caso #chat
&envia("join $chan \n"); #unirse al canal especificado
}
($nick, $type, $chanel, $matter, $nuck, $num) = split(/ /, $sdat);
($command, $texto) = split(/ :/, $sdat);
$kick = join(" ", $type, $chanel, $matter);
if ($kick =~ /(KICK $chan $bot)/) #si existe la combinación
{
&envia("join $chan\n"); #unirse al canal
}
#------------- access --------------------------------------
$isaccess = 0;
if( $nick =~ /^\:(\S*)\!(\S*)\@(\S*)/) #si los datos son envio de un usuario
{
$quien = $1;
&identidad($quien); #quien escribe es access?
if($isaccess == 1) #si es solo access
{
if($texto =~ /^(\!cmd)\s(.*)$/i) #comandos
{
&verificar; #verfica el nivel de acceso
$cmd = `$2`;
@out = split(/\n/, $cmd);
if ($chanel eq 'xBot'){ $chanel = "xpeed"} #privados
foreach $shit (@out)
{
&privmsg($chanel, "$shit");
}
}
if($texto =~ /^(\!envia)\s(.*)/i)
{
&verificar;
&envia($2);
}
if($texto =~ /^(\!add)\s(\w+)\s(\d)/i) #añadir acceso
{
&verificar; #verifica access
&add($2, $3);
}
if($texto =~ /^(\!accdel)\s(\w+)(\s+|\n+|)/i) #borrar acceso
{
&verificar; #verifica access
&accessdel($2);
}
if($texto =~ /^(\!setlv)\s(\w+)\s(\d)/i)
{
&verificar;
&setlv($2, $3);
}
if ($texto =~ /^(\!slap)\s(\w+)\s(.*)/i)
{
&slapper($2,$3);
#print("deberia slapear\n");
}
if ($texto =~ /^(\!time)(\n|\s|)$/i)
{
$tiempo = localtime(time);
&privmsg($chan, "$tiempo");
print("\<xBot\> $tiempo \n");
}
if ($texto =~ /^(\!say)\s(.*)(\n|\s|)$/i)
{
#$texto = substr($texto,5);
print("\<xBot\> $2\n");
&privmsg($chan, "$2");
}
if ($texto =~ /^(\!ip)\s(\w+)/i)
{
if ($chanel eq 'xBot'){ $chanel = "xpeed"} #privados
&envia("whois $2 \r\n");
$sock->recv($xdat, 128); #recibir 128 bytes donde está contenido el ident
@ident = split(/ /, $xdat); #dividir lo que llega
print("$xdat\n");
&ip($ident[4]);
}
if ($texto =~ /^(\!in)\s(\w+)/i)
{
if ($chanel eq 'xBot'){ $chanel = "xpeed"} #privados
$nuck = $2; &rchop(\$nuck);
&ip($nuck);
}
if ($texto =~ /^(\!list)(\n|\s|)/i)
{
&listaccess;
}
if ($texto =~ /^(\!help)(.*|\n|\s|)/i)
{
@comandos = ("accdel\tadd\tcmd\thelp", "list\tin\tip\tsay", "setlv\tslap\ttimer\tversion");
&privmsg($chan, "--------------Comandos------------");
foreach $shit (@comandos)
{
&privmsg($chan, "$shit");
}
}
if($texto =~ /^(\!version)(\n|\s|)/i)
{
&privmsg($chanel, "$bot version\: $version escrito por xpeed.");
}
if($texto =~ /^(\!quit)(\n|\s)/i)
{
exit;
}
$isaccess = 0;
} #if access
} #if quien
Err:;
} #while
# ----------- procesos ----------------
sub slapper
{
my ($nick2, $num2) = @_;
my @lin = (); my $slap;
&rchop(\$nick2, \$num2);
open(hFile, "<slaps.txt") || warn (&privmsg($chanel, "No se puede abrir slaps.txt $!"));
my @lin = <hFile>;
close(hFile);
if($num2 !~ /^[1-9]/) { $num2 = 1; }
for (my $i=0; $i<$num2; $i++)
{
$slap = ($lin[int(rand($#lin))]);
&rchop(\$slap);
print("\<xBot\> Slaps $nick2 with $slap \n");
&privmsg($chan, "\001ACTION Slaps $nick2 with $slap\001");
}
}
sub ip
{
my ($ip, @ip, @iphex, @iph);
$ip = "", @ip = (), @iphex = (), @iph = ();
my($country, @sta);
@iph = @_;
print("\<$bot\> $iph[0]\n");
for($i=0; $i<8; $i=$i+2)
{
push(@iphex, substr($iph[0], $i,2));
}
for($a=0; $a<4; $a++)
{
push(@ip, hex(@iphex[$a]));
}
$ip = join(".", @ip);
$country = `whois $ip | grep country -i -m 1`;
&rchop(\$country);
@sta = split(/:/, $country);
$sta[1] =~ tr/ //d;
$sta[1] =~ tr/country//d;
&privmsg($chanel, "$ip Pais: $sta[1]"); #envia a donde se le ordena
print("\<$bot\> $chan $ip Pais: $sta[1]\n");
}
sub envia
{
print $sock ("$_[0]\n"); #imprimir en el socket -enviar-
}
sub add
{
my ($nickname, $nivel) = @_ ; #nick y nivel a guardar en la base de datos
if($nivel !~ /^[1-5]/) { $nivel = 1; } #si el nivel no es numérico
&rchop(\$nivel, \$nickname); #sacar el retorno
#&rchop(\$nickname);
if($nivel =~ /^(1|2|3|4|5)$/) #si el nivel está en el rango
{
&identidad($nickname); #Comparar con la base de datos existente
if($isaccess == 1) #si ya es acces no lo pone
{
&privmsg($chan, "$nickname ya se encuentra en la lista access");
}
else #si no era access lo ingresa
{
&ingresar("$nickname\:\:$nivel");
&readd; #leer la base de datos actualizada
&privmsg($chan, "$nickname añadido a la lista de access con nivel $nivel") if($texto =~ /\!add/i);
}
$isaccess = 0; #retornar el valor a 0
}
}
sub privmsg
{
&envia("PRIVMSG $_[0] $_[1]");
}
sub listaccess
{
&privmsg($chan, "-------Lista de Access------");
foreach $shit (@access)
{
&privmsg($chan, "$shit");
}
}
sub readd
{
my $buf;
open(file,"<.acs.cfg") || warn( &privmsg($chan, "archivo de operadores no existente"));
while(<file>)
{
$buf .= &decode_base64($_);
}
@access = split(/\n/, $buf);
close(file);
}
sub identidad
{
my ($name) = shift; #nick que escribe
my $acsnick;
&rchop(\$name); $name =~ s/ //g; #sacar los retornos
$isaccess = 0; #asegurar que el valor inicial sea 0
for($i=0; $access[$i]; $i++) #recorrer el array con la lista access
{
&rchop(\$access[$i]) ; #sacar retornos de la lista
#print("$access[$i]\n"); #--> comprobacion de caracteres
if($access[$i] =~ /^($name)(\:+)(\d)(\n|\s|)$/) #si el nick concuerda con alguno de la lista
{
$isaccess = 1; #es access
$nivel = $3; #toma el nivel para restricciones
$acsnick = $1; #real nick
last; #rompe el for
}
}
#if($isaccess == 1)
#{
# &envia("privmsg nickserv status $name");
# $sock->recv($xdat, 128);
# my @inv = split(/ /, $xdat);
# $isaccess = 0 if($inv[5] != 3);
#}
}
sub ingresar
{
my $buf;
open(file,">>.acs.cfg") || warn( &privmsg($chan, "archivo de operadores no existente\n"));
$buf = &encode_base64("$_[0]\n");
print file ("$buf");
close(file);
}
sub accessdel
{
my ($dato) = shift; $i = 0;
my ($coincide, @artmp);
&rchop(\$dato); #$dato =~ s/ //g;
foreach $shit (@access)
{
&rchop(\$shit);
if($shit =~ /^($dato)(\:+|\s*)/)
{
#next;
$coincide = 1;
}
else
{
$artmp[$i] = $shit;
#print("$artmp[$i]\n");
$i += 1;
}
}
#print("@artmp\n");
if($coincide == 1)
{
my $buf;
open(file,">.acs.cfg");
foreach $shit (@artmp)
{
$buf = &encode_base64("$shit\n");
print file ("$buf");
}
close(file);
&readd;
&privmsg($chan, "entrada eliminada del acceso") if($texto =~ /\!accdel/i) ;
}
}
sub get
{
my $buf;
open(file, "<.com");
$buf = <file>;
$buf = &decode_base64($buf);
close(file);
return $buf;
}
sub rchop
{
my ($x, $y, $z) = @_;
$$x =~ s/\n//gi;
$$y =~ s/\n//gi;
$$z =~ s/\n//gi;
}
sub verificar
{
if($nivel <= 4) { &privmsg($chanel, "acceso denegado."); goto(Err); }
}
sub setlv
{
my ($nik, $nnivel) = @_ ;
$isaccess = 0;
if($nnivel !~ /^[1-5]/) { $nnivel = 1; }
&identidad($nik);
if($isaccess == 1)
{
&privmsg($chanel, "cambiando el nivel de $nik ...");
&accessdel($nik);
&add($nik, $nnivel);
&privmsg($chanel, "Cambio de nivel satisfactorio.");
}
else
{
&privmsg($chanel, "Ese usuario no es access.");
}
}
use strict;
use MIME::Base64 qw(decode_base64);
use MIME::Base64 qw(encode_base64);
use IO::Socket;
#-------------------- constantes ------------------------
#my $server = 'irc.accesox.net';
my $server = 'irc.emule-spain.org';
my $port = '6667';
my $bot = my $name = 'xBot';
my $clave = &get; &rchop(\$clave);
my $version = '1.0';
my $isaccess = 0; my $nivel;
my $chan;
my @access;
#--------------------------------------------------------
#------------------declaraciones-------------------------
my (@out, # salida del comando cmd
@ident, # ident obtenido
@comandos, # lista de comandos
$nick, # nick de entrada (no es el del bot, es de quien escriba)
$type, # tipo de entrada (privmsg, join, version .. etc)
$chanel, # canal de entrada
$matter, # primera cadena del mensaje
$nuck, # segunda cadena del mensaje
$num, # resto de cadenas del mensaje
$command, # primera parte del mensaje (nick@ident tipo)
$texto, # segunda parte del mensaje (mensaje en sí)
$kick, # conjunto del nick canal y tipo kick
$quien, # quien es el que escribe
$cmd, # comando
$tiempo, # tiempo y timer
$i, # contador
$shit, # elemento del foreach
$xdat); # datos recibidos en el ident
#--------------------------------------------------------
my $sock = IO::Socket::INET->new(
PeerAddr => "$server",
PeerPort => "$port",
Proto => 'tcp' ) || print("No hay conexión\.\n\cC");
#--------------------------------------------------------
system('clear');
print("$bot version\: $version by xpeed \nCanal\: "); $chan = <STDIN>;
&rchop(\$chan);
#--------------------------------------------------------
&readd; #leer access
while(<$sock>) #Datos que llegan al socket
{
my $sdat = $_; #datos que llegan a $_
print($sdat); #imprimirlos
if ($sdat =~ /NOTICE AUTH/i) #Si en los datos llega el pedido de autenticación
{
&envia("NICK $bot \n"); #enviar el nick
&envia("USER $name x x x x\n"); #enviar los 5 parametros de usuario
}
if ($sdat =~ /^PING :/i) #si llega la solicitud de PING
{
&envia("PONG :$'"); #enviar el número de autenticación
}
if ($sdat =~ /(376)/i) #si llega el codigo 376 End MOTD
{
&envia("ns identify $clave\n"); #identificarse con la clave
&envia("part #chat \n"); #partir del canal inicial en este caso #chat
&envia("join $chan \n"); #unirse al canal especificado
}
($nick, $type, $chanel, $matter, $nuck, $num) = split(/ /, $sdat);
($command, $texto) = split(/ :/, $sdat);
$kick = join(" ", $type, $chanel, $matter);
if ($kick =~ /(KICK $chan $bot)/) #si existe la combinación
{
&envia("join $chan\n"); #unirse al canal
}
#------------- access --------------------------------------
$isaccess = 0;
if( $nick =~ /^\:(\S*)\!(\S*)\@(\S*)/) #si los datos son envio de un usuario
{
$quien = $1;
&identidad($quien); #quien escribe es access?
if($isaccess == 1) #si es solo access
{
if($texto =~ /^(\!cmd)\s(.*)$/i) #comandos
{
&verificar; #verfica el nivel de acceso
$cmd = `$2`;
@out = split(/\n/, $cmd);
if ($chanel eq 'xBot'){ $chanel = "xpeed"} #privados
foreach $shit (@out)
{
&privmsg($chanel, "$shit");
}
}
if($texto =~ /^(\!envia)\s(.*)/i)
{
&verificar;
&envia($2);
}
if($texto =~ /^(\!add)\s(\w+)\s(\d)/i) #añadir acceso
{
&verificar; #verifica access
&add($2, $3);
}
if($texto =~ /^(\!accdel)\s(\w+)(\s+|\n+|)/i) #borrar acceso
{
&verificar; #verifica access
&accessdel($2);
}
if($texto =~ /^(\!setlv)\s(\w+)\s(\d)/i)
{
&verificar;
&setlv($2, $3);
}
if ($texto =~ /^(\!slap)\s(\w+)\s(.*)/i)
{
&slapper($2,$3);
#print("deberia slapear\n");
}
if ($texto =~ /^(\!time)(\n|\s|)$/i)
{
$tiempo = localtime(time);
&privmsg($chan, "$tiempo");
print("\<xBot\> $tiempo \n");
}
if ($texto =~ /^(\!say)\s(.*)(\n|\s|)$/i)
{
#$texto = substr($texto,5);
print("\<xBot\> $2\n");
&privmsg($chan, "$2");
}
if ($texto =~ /^(\!ip)\s(\w+)/i)
{
if ($chanel eq 'xBot'){ $chanel = "xpeed"} #privados
&envia("whois $2 \r\n");
$sock->recv($xdat, 128); #recibir 128 bytes donde está contenido el ident
@ident = split(/ /, $xdat); #dividir lo que llega
print("$xdat\n");
&ip($ident[4]);
}
if ($texto =~ /^(\!in)\s(\w+)/i)
{
if ($chanel eq 'xBot'){ $chanel = "xpeed"} #privados
$nuck = $2; &rchop(\$nuck);
&ip($nuck);
}
if ($texto =~ /^(\!list)(\n|\s|)/i)
{
&listaccess;
}
if ($texto =~ /^(\!help)(.*|\n|\s|)/i)
{
@comandos = ("accdel\tadd\tcmd\thelp", "list\tin\tip\tsay", "setlv\tslap\ttimer\tversion");
&privmsg($chan, "--------------Comandos------------");
foreach $shit (@comandos)
{
&privmsg($chan, "$shit");
}
}
if($texto =~ /^(\!version)(\n|\s|)/i)
{
&privmsg($chanel, "$bot version\: $version escrito por xpeed.");
}
if($texto =~ /^(\!quit)(\n|\s)/i)
{
exit;
}
$isaccess = 0;
} #if access
} #if quien
Err:;
} #while
# ----------- procesos ----------------
sub slapper
{
my ($nick2, $num2) = @_;
my @lin = (); my $slap;
&rchop(\$nick2, \$num2);
open(hFile, "<slaps.txt") || warn (&privmsg($chanel, "No se puede abrir slaps.txt $!"));
my @lin = <hFile>;
close(hFile);
if($num2 !~ /^[1-9]/) { $num2 = 1; }
for (my $i=0; $i<$num2; $i++)
{
$slap = ($lin[int(rand($#lin))]);
&rchop(\$slap);
print("\<xBot\> Slaps $nick2 with $slap \n");
&privmsg($chan, "\001ACTION Slaps $nick2 with $slap\001");
}
}
sub ip
{
my ($ip, @ip, @iphex, @iph);
$ip = "", @ip = (), @iphex = (), @iph = ();
my($country, @sta);
@iph = @_;
print("\<$bot\> $iph[0]\n");
for($i=0; $i<8; $i=$i+2)
{
push(@iphex, substr($iph[0], $i,2));
}
for($a=0; $a<4; $a++)
{
push(@ip, hex(@iphex[$a]));
}
$ip = join(".", @ip);
$country = `whois $ip | grep country -i -m 1`;
&rchop(\$country);
@sta = split(/:/, $country);
$sta[1] =~ tr/ //d;
$sta[1] =~ tr/country//d;
&privmsg($chanel, "$ip Pais: $sta[1]"); #envia a donde se le ordena
print("\<$bot\> $chan $ip Pais: $sta[1]\n");
}
sub envia
{
print $sock ("$_[0]\n"); #imprimir en el socket -enviar-
}
sub add
{
my ($nickname, $nivel) = @_ ; #nick y nivel a guardar en la base de datos
if($nivel !~ /^[1-5]/) { $nivel = 1; } #si el nivel no es numérico
&rchop(\$nivel, \$nickname); #sacar el retorno
#&rchop(\$nickname);
if($nivel =~ /^(1|2|3|4|5)$/) #si el nivel está en el rango
{
&identidad($nickname); #Comparar con la base de datos existente
if($isaccess == 1) #si ya es acces no lo pone
{
&privmsg($chan, "$nickname ya se encuentra en la lista access");
}
else #si no era access lo ingresa
{
&ingresar("$nickname\:\:$nivel");
&readd; #leer la base de datos actualizada
&privmsg($chan, "$nickname añadido a la lista de access con nivel $nivel") if($texto =~ /\!add/i);
}
$isaccess = 0; #retornar el valor a 0
}
}
sub privmsg
{
&envia("PRIVMSG $_[0] $_[1]");
}
sub listaccess
{
&privmsg($chan, "-------Lista de Access------");
foreach $shit (@access)
{
&privmsg($chan, "$shit");
}
}
sub readd
{
my $buf;
open(file,"<.acs.cfg") || warn( &privmsg($chan, "archivo de operadores no existente"));
while(<file>)
{
$buf .= &decode_base64($_);
}
@access = split(/\n/, $buf);
close(file);
}
sub identidad
{
my ($name) = shift; #nick que escribe
my $acsnick;
&rchop(\$name); $name =~ s/ //g; #sacar los retornos
$isaccess = 0; #asegurar que el valor inicial sea 0
for($i=0; $access[$i]; $i++) #recorrer el array con la lista access
{
&rchop(\$access[$i]) ; #sacar retornos de la lista
#print("$access[$i]\n"); #--> comprobacion de caracteres
if($access[$i] =~ /^($name)(\:+)(\d)(\n|\s|)$/) #si el nick concuerda con alguno de la lista
{
$isaccess = 1; #es access
$nivel = $3; #toma el nivel para restricciones
$acsnick = $1; #real nick
last; #rompe el for
}
}
#if($isaccess == 1)
#{
# &envia("privmsg nickserv status $name");
# $sock->recv($xdat, 128);
# my @inv = split(/ /, $xdat);
# $isaccess = 0 if($inv[5] != 3);
#}
}
sub ingresar
{
my $buf;
open(file,">>.acs.cfg") || warn( &privmsg($chan, "archivo de operadores no existente\n"));
$buf = &encode_base64("$_[0]\n");
print file ("$buf");
close(file);
}
sub accessdel
{
my ($dato) = shift; $i = 0;
my ($coincide, @artmp);
&rchop(\$dato); #$dato =~ s/ //g;
foreach $shit (@access)
{
&rchop(\$shit);
if($shit =~ /^($dato)(\:+|\s*)/)
{
#next;
$coincide = 1;
}
else
{
$artmp[$i] = $shit;
#print("$artmp[$i]\n");
$i += 1;
}
}
#print("@artmp\n");
if($coincide == 1)
{
my $buf;
open(file,">.acs.cfg");
foreach $shit (@artmp)
{
$buf = &encode_base64("$shit\n");
print file ("$buf");
}
close(file);
&readd;
&privmsg($chan, "entrada eliminada del acceso") if($texto =~ /\!accdel/i) ;
}
}
sub get
{
my $buf;
open(file, "<.com");
$buf = <file>;
$buf = &decode_base64($buf);
close(file);
return $buf;
}
sub rchop
{
my ($x, $y, $z) = @_;
$$x =~ s/\n//gi;
$$y =~ s/\n//gi;
$$z =~ s/\n//gi;
}
sub verificar
{
if($nivel <= 4) { &privmsg($chanel, "acceso denegado."); goto(Err); }
}
sub setlv
{
my ($nik, $nnivel) = @_ ;
$isaccess = 0;
if($nnivel !~ /^[1-5]/) { $nnivel = 1; }
&identidad($nik);
if($isaccess == 1)
{
&privmsg($chanel, "cambiando el nivel de $nik ...");
&accessdel($nik);
&add($nik, $nnivel);
&privmsg($chanel, "Cambio de nivel satisfactorio.");
}
else
{
&privmsg($chanel, "Ese usuario no es access.");
}
}
Coloreado en 0.010 segundos, usando GeSHi 1.0.8.4
Si eres de los que se preguntan... "por qué no tomar uno como el eggdrop que ya está codeado?" ... pues no sé tu, pero a mí personalmente me gusta usar lo que yo haya hecho a lo que alguien codeó y disfrutó haciendo... si has leído hasta aquí te agradezco que te hayas tomado el tiempo...
Un saludo.
