• Publicidad

IRC Bot

¿Ya sabes lo que es una referencia? Has progresado, el nível básico es cosa del pasado y ahora estás listo para el siguiente nivel.

IRC Bot

Notapor MidNight » 2006-05-18 00:14 @051

Muy probablemente la mayoría de usuarios experimentados conocerán cómo se realizan este tipo de programas y cómo implementar el protocolo IRC para realizarlo, sin embargo el siguiente topic va orientado a aquellos quienes sus conocimientos no son tan avanzados y personas que no han tenido contacto con el protocolo IRC.

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.
    Tras los tres procedimientos anteriores -si nada ha salido mal- la conexión estará totalmente establecida, por lo tanto al saber esto ya se puede empezar realizar la codificación del bot que resuelva estos tres pasos correctamente (obviamente el lenguaje en el que se escribirá será Perl).
  • 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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    use 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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    MIME::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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
      use 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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using bash Syntax Highlighting
    xpeed@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 :287052B8
    Coloreado 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)

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    system('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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
        if ($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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
        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
        }
    }

    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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
        my ($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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    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
        }  
    }
    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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    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);      
    }
    Coloreado en 0.002 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:

    Sintáxis: [ Descargar ] [ Ocultar ]
    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.002 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.

Sintáxis: [ Descargar ] [ Ocultar ]
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.");
    }
}
Coloreado en 0.011 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.
Imagen
Avatar de Usuario
MidNight
Perlero nuevo
Perlero nuevo
 
Mensajes: 21
Registrado: 2006-04-29 13:31 @604

Publicidad

Notapor Invitado » 2006-05-18 08:37 @401

Que tal,

El código que posteas arriba parece tener mucho tiempo de estar codificado, o al menos tiene prácticas un tanto malas sobre tratamiento de información y sintaxis de Perl.

Apoyo tu idea de que es bueno aprender cómo se hacen las cosas, sin embargo, para hacer un bot de IRC si necesitas leer al menos un poco del RFC 1459 para conocer y comprender los eventos que suceden durante la comunicación.

Ahora en lo personal, siendo IRC un protocolo de comunicaciones "concurrentes" en cuestión de sucesos, yo no recomendaría hacer todo tan lineal con IO::Socket, en lo personal recomiendo POE::Component::IRC con el cual están escritos varios bots por allí, o también recomiendo una interfaz de mas alto nivel llamada Basic::Bot, ambos en CPAN. Ahora si quires implementar algo verdaderamente asíncrono ( que no le veo caso, pero sucede.... ) podrías utilizar Danga::Socket.

La idea de esto...., es interesante una guía sobre como escribir un bot, pero es mas interesante comprender realmente lo que una conexión a IRC conlleva y a su vez ser capaz de escribir el código que maneje bien todo eso, incluyendo cuestiones de seguridad y eficiencia.

Saludos,
Invitado
 

Notapor Perl user » 2006-05-18 08:53 @412

Woops....

El autor de la respuesta anterior soy yo. En fin te dejo una URL del cookbook de POE de como escribir un sencillo bot, al menos en este ejemplo convierte los mensajes a sus equivalentes en rot13.

http://poe.perl.org/?POE_Cookbook/IRC_Bots

Por cierto, el otro módulo, el nombre correcto es Bot::BasicBot, que como mencionè es una simple interfaz de mas alto nivel que PoCo::IRC ( está escrito sobre éste ).

PD. Hace 3 años escribí un bot para extraer headers de un RSS para un canal en español, lo escribí utilizando Socket.pm, y creeme, escribir cosas así es un poco doloroso y "sangrante" :)

Saludos,
Marco A. Manzo
[email protected]
http://www.unixmonkeys.com/amnesiac/
Perl Programming Language
Perl user
Maestro honorario
Maestro honorario
 
Mensajes: 271
Registrado: 2004-11-03 21:11 @924

Notapor MidNight » 2006-05-19 00:48 @075

Hola allá,

Perl user escribiste:Ahora en lo personal, siendo IRC un protocolo de comunicaciones "concurrentes" en cuestión de sucesos, yo no recomendaría hacer todo tan lineal con IO::Socket, en lo personal recomiendo POE::Component::IRC con el cual están escritos varios bots por allí


Debo decir que estoy de acuerdo contigo, sería mucho más eficiente usar una programacion orientada a eventos (con los diferentes modulos disponibles) y no tan lineal, aunque no tengo mucha experiencia en codigo perl estoy seguro y deacuerdo en que el programa expuesto puede ser mejorado considerablemente, intentaré profundizar en estos puntos de vista para intentar mejorar el codigo, gracias por la critica constructiva :)

un saludo.
Imagen
Avatar de Usuario
MidNight
Perlero nuevo
Perlero nuevo
 
Mensajes: 21
Registrado: 2006-04-29 13:31 @604

Notapor creating021 » 2006-05-22 18:30 @813

Mira el módulo Net::IRC, para que profundices
Expect the worst, is it the least you can do?
Avatar de Usuario
creating021
Perlero frecuente
Perlero frecuente
 
Mensajes: 595
Registrado: 2006-02-23 16:17 @720
Ubicación: Frente al monitor

Notapor Perl user » 2006-05-23 07:25 @350

creating021 escribiste:Mira el módulo Net::IRC, para que profundices

Lamento informarte que Net::IRC quedó despreciado hace mucho tiempo por falta de compatibilidad con el actual RFC del protocolo de IRC, además de severos bugs encontrados. Por eso se recomienda el uso de POE::Component::IRC.

Estuvieron trabajando en Net::IRC2 que era una mejor implementación que su antecesor, sin embargo han descontinuado su desarrollo gracias a que vieron mucha más actividad en un módulo que es multitareas, a un módulo simplemente secuencial.

Saludos,
Marco A. Manzo
[email protected]
http://www.unixmonkeys.com/amnesiac/
Perl Programming Language
Perl user
Maestro honorario
Maestro honorario
 
Mensajes: 271
Registrado: 2004-11-03 21:11 @924

Re: IRC Bot

Notapor ubuntu » 2009-08-19 09:22 @432

Buenas.

Me gusta tu proyecto :)

Yo también tengo un proyecto de bots de servicios para unrealircd.

Con este proyecto empecé con Perl, y ahora no duermo, jajaja.
No está terminado, pero por compartir:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl -W
  2.  
  3. use IO::Socket;
  4.  
  5. #variables
  6. $server = "services.host";
  7. $serveremoto = "127.0.0.1";
  8. $serverdesc = "RoBoTservice";
  9. $key = "contrasena";
  10. $numeric = 200;
  11. ## NICK de los bots de servicios
  12. $nick_chan = "CHaN";
  13. $nick_nick = "NiCK";
  14. $nick_creg = "CReG";
  15. $chan_dias = 15;
  16.  
  17. #NO MODIFICAR NADA
  18. $numero = 9999;
  19.  
  20.  
  21. $envia = IO::Socket::INET->new(
  22. Proto=>"tcp" ,
  23. PeerAddr=> $serveremoto ,
  24. PeerPort=>"4400"
  25. )
  26. or die "No se pudo lograr la conexion con $serveremoto .\n";
  27.  
  28. print "Conectado a $serveremoto\n";
  29.  
  30. print $envia "PASS $key\n";
  31. print $envia "SERVER $server 1 :U0-*-$numeric $serverdesc\n";
  32. print $envia "NICK $nick_chan 1 1475205493 $nick_chan Local $server 0 +oiSq local :$nick_chan\n";
  33. print $envia "NICK $nick_nick 1 1475205494 $nick_nick Local $server 0 +oiSq local :$nick_nick\n";
  34. print $envia "NICK $nick_creg 1 1475205495 $nick_creg Local $server 0 +oiSq local :$nick_creg\n";
  35.  
  36. #While comprueba cada vez que el socket recive o envia informacion y almacena los datos en variables temporarmente para su uso
  37. while (<$envia>)
  38. {
  39. @space = split(" ",$_);
  40. @dots = split (":",$_);
  41. @snick = split(" ",$dots[1]);
  42. @dice = split(" ",$dots[2]);
  43. print "<-" . $_;
  44.  
  45.         #PING responde a los ping del servidor
  46.         if ($space[0] eq "PING")
  47.         {
  48.         print $envia "PONG" . $dots[1] . "\n";
  49.         }
  50.         #NICK mira cuando conecta un nick, y comprueba si esta registrado, de estarlo, pide que se identifique
  51.         if ($space[0] eq "NICK")
  52.         {
  53.         &lee_nick("$space[1]");
  54.                 if($nick_leenick[0] eq $space[1])
  55.                 {
  56.                 my $rango = 9999;
  57.                 my $otrorango = 963086439;
  58.                 my $rando = int(rand($otrorango));
  59.                 my $random_number = int(rand($rango));
  60.                 print $envia ":$nick_nick PRIVMSG $space[1] :El nick esta registrado.Si el nick le pertenese, identifiquese de este modo\n";
  61.                 print $envia ":$nick_nick PRIVMSG $space[1] :/msg $nick_nick IDENTIFICA $space[1] contraseña \n";
  62.                 print $envia "SVSNICK $space[1] invi-$random_number $rando\n";
  63.                 }
  64.         }
  65.         if ($space[1] eq "JOIN")
  66.         {
  67.         my($levejoin);
  68.         my(@lee_joinlee);
  69.         my($datos_joinlee_temp);
  70.         my(@separa_joinlee);
  71.  
  72.         open(joinlee,"<$space[2].txt");
  73.         @lee_joinlee =<joinlee>;
  74.                 foreach $datos_joinlee_temp(@lee_joinlee)
  75.                 {
  76.                 @separa_joinlee = split(" ",$datos_joinlee_temp);
  77.                         if ($separa_joinlee[0] eq $snick[0])
  78.                         {
  79.                         $levejoin = $separa_joinlee[1];
  80.                         }
  81.                 }
  82.                 close(joinlee);
  83.                 if ($levejoin >= 300)
  84.                 {
  85.                 print $envia ":$nick_chan MODE $space[2] +o $snick[0] \n";
  86.                 }
  87.                 elsif ($levejoin <= 299 && $levejoin >= 150)
  88.                 {
  89.                 print $envia ":$nick_chan MODE $space[2] +v $snick[0] \n";
  90.                 }      
  91.                 my(@lee_joincanal);
  92.                 my($datos_joincanal);
  93.                 my(@separa_joincanal);
  94.                 open(joincanal,"<$space[2].txt");
  95.                 @lee_joincanal=<joincanal>;
  96.                         foreach $datos_joincanal(@lee_joincanal)
  97.                         {
  98.                         @separa_joincanal = split(" ",$datos_joincanal);
  99.                                 if ($separa_joincanal[0] eq "MODO")
  100.                                 {
  101.                                 print $envia ":$nick_chan MODE $space[2] +$separa_joincanal[1] \n";
  102.                                 }
  103.                                 if ($separa_joincanal[0] eq "TOPIC")
  104.                                 {
  105.                                 print $envia ":$nick_chan TOPIC $space[2] $separa_joincanal[1] \n";
  106.                                 }
  107.                         }
  108.                 close(joincanal);
  109.         }
  110.         #SENDSNO comprueba cuando algien se logea como Administrador , Ircop , Operador...
  111.         if ($space[1] eq "SENDSNO")
  112.         {
  113.                 if ($dice[7] eq "administrator")
  114.                 {
  115.                 open(leead,"<ircop.txt");
  116.                 @lee_ircop =<leead>;
  117.                 my($stircop);
  118.                         foreach $lee_datos_ircop(@lee_ircop)
  119.                         {
  120.                         @separa_temp = split(" ",$lee_datos_ircop);
  121.                                 if ($separa_temp[0] eq $dice[0])
  122.                                 {
  123.                                 $ircop{$dice[0]}="2";
  124.                                 close(leead);
  125.                                 }
  126.                         }
  127.                         $stircop = exists $ircop{$dice[0]};
  128.                         if ($stircop == 0)
  129.                         {
  130.                         open(leead,">>ircop.txt");
  131.                         print leead "$dice[0] 2\n";
  132.                         close(leead);
  133.                         $ircop{$dice[0]}="2";
  134.                         }
  135.                 }
  136.         }
  137.         #PRIVMSG comprueba si el mensaje va a algun bot de servicio
  138.         if ($space[1] eq "PRIVMSG")
  139.         {
  140.                 if("\u".$space[2]."\l" eq "\u$nick_chan\l")
  141.                 {
  142.                 &chan("$snick[0]","$dice[0]","$dice[1]","$dice[2]","$dice[3]","$dice[4]");     
  143.                 }
  144.                 elsif("\u".$space[2]."\l" eq "\u$nick_creg\l")
  145.                 {
  146.                 &creg("$snick[0]","$dice[0]","$dice[1]","$dice[2]","$dice[3]");
  147.                 }
  148.                 elsif("\u".$space[2]."\l" eq "\u$nick_nick\l")
  149.                 {
  150.                 &nick("$snick[0]","$dice[0]","$dice[1]","$dice[2]");
  151.                 }
  152.         }
  153. }
  154.  
  155. sub lee_canal
  156. {
  157. my($chan);
  158. my($passchan);
  159. my($funder);
  160. my($describe);
  161. my($topic);
  162. my(@canal_text);
  163. my(@separa_lee_canal);
  164. my($datos_canal);
  165.  
  166.  open(canaltext,"<$_[0].txt");
  167.   @canal_text=<canaltext>;
  168.         foreach $datos_canal(@canal_text)
  169.         {
  170.         @separa_lee_canal = split(" ",$datos_canal);
  171.                 if ($separa_lee_canal[0] eq "CANAL")
  172.                 {
  173.                 $chan = $separa_lee_canal[1];
  174.                 }
  175.                 if ($separa_lee_canal[0] eq "PASS")
  176.                 {
  177.                 $passchan = $separa_lee_canal[1];
  178.                 }
  179.                 if ($separa_lee_canal[0] eq "FUNDER")
  180.                 {
  181.                 $funder = $separa_lee_canal[1];
  182.                 }
  183.                 if ($separa_lee_canal[0] eq "DESCRIPCION")
  184.                 {
  185.                 $describe = $separa_lee_canal[1];
  186.                 }
  187.                 if ($separa_lee_canal[0] eq "TOPIC")
  188.                 {
  189.                 $topic = $separa_lee_canal[1];
  190.                 }
  191.                 if ($separa_lee_canal[0] eq "MODO")
  192.                 {
  193.                 $modos = $separa_lee_canal[1];
  194.                 }
  195.                
  196.         }
  197.         close(canaltext);
  198.         @chan_temp =("$chan","$passchan","$funder","$describe","$topic","$modos");
  199. }
  200.  
  201. #Nick toda las funciones
  202. sub nick
  203. {
  204.         if ($_[1] eq "REGISTER")
  205.         {
  206.         my $email = $_[2];
  207.         my $nick_register = $_[0];
  208.         &nick_register("$nick_register","$email");
  209.         }
  210.         elsif ($_[1] eq "HELP")
  211.         {
  212.         &nick_help("$_[0]","$_[2]");
  213.         }
  214.         elsif ($_[1] eq "IDENTIFICA")
  215.         {
  216.         my $nick_identifica_envia = $_[0];
  217.         my $nick_identifica_pass = $_[3];
  218.         my $nick_identifica_nick = $_[2];
  219.         &nick_identifica("$nick_identifica_envia","$nick_identifica_nick","$nick_identifica_pass");
  220.         }
  221.        
  222. }
  223.  
  224. sub lee_nick
  225. {
  226. my(@lee_nick);
  227. my($datos_leenick);
  228. my(@separa_leenick);
  229. my($lee_nick_user);
  230. my($lee_nick_pass);
  231. my($lee_nick_email);
  232. open(leenick,"<$_[0].txt");
  233. @lee_nick=<leenick>;
  234.         foreach $datos_leenick(@lee_nick)
  235.         {
  236.         @separa_leenick = split(" ",$datos_leenick);
  237.                 if ($separa_leenick[0] eq "NICK")
  238.                 {
  239.                 $lee_nick_user = $separa_leenick[1];
  240.                 }
  241.                 if ($separa_leenick[0] eq "PASS")
  242.                 {
  243.                 $lee_nick_pass = $separa_leenick[1];
  244.                 }
  245.                 if ($separa_leenick[0] eq "EMAIL")
  246.                 {
  247.                 $lee_nick_email = $separa_leenick[1];
  248.                 }
  249.         }
  250. @nick_leenick =("$lee_nick_user","$lee_nick_pass","$lee_nick_email");
  251. close(leenick);
  252.  
  253. }              
  254.  
  255. sub nick_identifica
  256. {
  257. &lee_nick("$_[1]");
  258. my $nick_user_iden = $nick_leenick[0];
  259. my $nick_pass_iden = $nick_leenick[1];
  260.         if ($nick_user_iden eq $_[1] && $nick_pass_iden eq $_[2])
  261.         {
  262.         my $randis = int(rand(963086432));
  263.         print $envia "SVSNICK $_[0]  $_[1] $randis \n";
  264.         print $envia ":$nick_chan SVSMODE $_[1] +r \n";
  265.         print $envia ":$nick_nick PRIVMSG $_[1] :Contraseña aceptada, Bienvenido a casa ;) \n";
  266.         }
  267. }
  268.  
  269.  
  270. sub nick_register
  271. {
  272. my($lee_register_nick);
  273. my(@register_mira_nick);
  274. my($comprueba_nick);
  275. my(@nick_register);
  276. open(leenick,">>$_[0].txt");
  277. $pass_rand = int(rand($numero));
  278. $rand_num = rand($numero);
  279. print leenick "NICK $_[0] \n";
  280. print leenick "PASS $pass_rand   \n";
  281. print leenick "EMAIL $_[1] \n";
  282. print leenick "AKICK \n";
  283. close(leenick);
  284. my $randiss = int(rand(963086432));
  285. my $numran = int(rand(9999));
  286. print $envia ":$nick_nick PRIVMSG $_[0] :Su nick fue registrado , para identificarse escriba /msg $nick_nick IDENTIFICA $_[0] $pass_rand \n";
  287. print $envia ":$nick_nick PRIVMSG $_[0] :para cambiar su contraseña escriba (debe tener el nick IDENTIFICADO para poder usar este comando \n";
  288. print $envia ":$nick_nick PRIVMSG $_[0] :/msg $nick_nick PASSMODIFI antiguacontraseña nuevacontraseña \n";
  289. print $envia "SVSNICK $_[0] invi-$numran $randiss \n";
  290.  
  291. }
  292.  
  293. #chan toda las funciones
  294. sub chan
  295. {
  296.         if($_[1] eq "HELP")
  297.         {      
  298.         &chan_help("$_[0]","$_[1]","$_[2]");
  299.         }
  300.         if($_[1] eq "OP")
  301.         {
  302.         &chan_op("$_[0]","$_[2]","$_[3]");
  303.         }
  304.         if($_[1] eq "ACCESS")
  305.         {
  306.         my $elnickmanda = $_[0];
  307.         my $canalmanda = $_[2];
  308.         my $opcionmanda = $_[3];
  309.         my $esenickmanda = $_[4];
  310.         my $nivelmanda = $_[5];
  311.         &chan_access("$elnickmanda","$canalmanda","$opcionmanda","$esenickmanda","$nivelmanda");
  312.         }
  313.         if($_[1] eq "IDENTIFICA")
  314.         {
  315.         &chan_identifica("$_[0]","$_[2]","$_[3]");
  316.         }
  317.         if ($_[1] eq "INFO")
  318.         {
  319.         &chan_info("$_[0]","$_[2]");
  320.         }
  321. }
  322.        
  323.  
  324.  
  325.  
  326. sub chan_info
  327. {
  328. &lee_canal("$_[1]");
  329.         if ($chan_temp[0] eq "$_[1]")
  330.         {
  331.         my $canal_info = $chan_temp[0];
  332.         my $fundador_info = $chan_temp[2];
  333.         my $descrip_info = $chan_temp[3];
  334.         my $topic_info = $chan_temp[4];
  335.         my $modos_info = $chan_temp[5];
  336.         print $envia ":$nick_chan PRIVMSG $_[0] :Informacion del canal $canal_info \n";
  337.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  338.         print $envia ":$nick_chan PRIVMSG $_[0] :Fundador : $fundador_info \n";
  339.         print $envia ":$nick_chan PRIVMSG $_[0] :TOPIC :$topic_info \n";
  340.         print $envia ":$nick_chan PRIVMSG $_[0] :Usa Los modos $modos_info \n";
  341.         }
  342. }
  343.  
  344.  
  345. sub chan_identifica
  346. {
  347.         if (!$nicks{$_[0]})
  348.         {
  349.         &lee_canal("$_[1]");
  350.                 if ($chan_temp[0] eq "$_[1]")
  351.                 {
  352.                 my $chan_canal_identifica = $chan_temp[0];
  353.                 my $chan_pass_identifica = $chan_temp[1];
  354.                 my $chan_funder_identifica = $chan_temp[2];
  355.                         if ($chan_canal_identifica eq $_[1] && $chan_pass_identifica eq $_[2] && $chan_funder_identifica eq $_[0])
  356.                         {
  357.                         print $envia ":$nick_chan PRIVMSG $_[0] :Se a identificado correctamente como Fundador de $_[1] \n";
  358.                         print $envia ":$nick_chan MODE $_[1] +q $_[0]\n";
  359.                         $nicks{$_[0]}="$_[1]";
  360.                         }
  361.                 }
  362.         }
  363. }              
  364.  
  365.  
  366. sub chan_access
  367. {
  368. my($nivel);
  369. my($founder);
  370.         if ($_[2] eq "ADD")
  371.         {
  372.         open(leechanaccess,"<$_[1].txt");
  373.         my @lee_chan_access =<leechanaccess>;
  374.                 foreach $chan_access_datos_temp(@lee_chan_access)
  375.                 {
  376.                 @datos_lee_chan_access = split(" ",$chan_access_datos_temp);
  377.                         if ($datos_lee_chan_access[0] eq $_[0])
  378.                         {
  379.                         $nivel = $datos_lee_chan_access[1];    
  380.                         }
  381.                 }
  382.         }
  383.         close(leechanaccess);
  384.         if($_[4] <= $nivel)
  385.         {
  386.         open(miranickaccess,"<$_[3].txt");
  387.         @mira_nickaccess =<miranickaccess>;
  388.         my($registrado_nick);
  389.                 foreach $datos_miranickaccess_temp(@mira_nickaccess)
  390.                 {
  391.                         @separo_datosaccess = split(" ",$datos_miranickaccess_temp);
  392.                         if ($separo_datosaccess[1] eq $_[3])
  393.                         {
  394.                         open(anadeaccess,">>$_[1].txt");
  395.                         print anadeaccess "$_[3] $_[4]\n";
  396.                         close(anadeaccess);
  397.                         print $envia ":$nick_chan NOTICE $_[1] :$_[0] Añade a la lista de ACCESS a $_[3] con nivel $_[4] \n";
  398.                         $registrado_nick = "si";
  399.                         }
  400.                        
  401.                 }      
  402.                 if (!$registrado_nick)
  403.                 {                
  404.                 print $envia ":$nick_chan PRIVMSG $_[0] :Lo sentimos,el nick $_[3] , parece no tener el nick registrado \n";
  405.                 }
  406.         }
  407. }
  408.  
  409. sub creg_help
  410. {
  411.         if (!$_[2])
  412.         {
  413.         print $envia ":$nick_creg PRIVMSG $_[0] :Comando de ayuda para $nick_creg \n";
  414.         print $envia ":$nick_creg PRIVMSG $_[0] :Sintaxis /msg $nick_creg REGISTER <canal> <contraseña> <descripcion> \n";
  415.         }
  416. }
  417.  
  418. sub chan_op
  419. {
  420. my($levels);
  421. open(chanop,"<$_[1].txt");
  422. @lee_chanop=<chanop>;
  423.         foreach $datos_chanop_temp(@lee_chanop)
  424.         {
  425.         @separa_chanop = split(" ",$datos_chanop_temp);
  426.                 if($separa_chanop[0] eq $_[0])
  427.                 {
  428.                 $levels = $separa_chanop[1];
  429.                         if($levels >= 150)
  430.                         {
  431.                         print $envia ":$nick_chan MODE $_[1] +o $_[2] \n";
  432.                         close(chanop);
  433.                         }
  434.                         elsif($levels < 150)
  435.                         {
  436.                         print $envia ":$nick_chan PRIVMSG $_[0] :Lo siento, no tiene suficiente nivel \n";
  437.                         close(chanop);
  438.                         }
  439.                 }
  440.         }
  441.         close(chanop);
  442. }
  443.  
  444. sub chan_help
  445. {
  446.         if (!$_[2])
  447.         {
  448.         print $envia ":$nick_chan PRIVMSG $_[0] :Comando ayuda para $nick_chan \n";
  449.         print $envia ":$nick_chan PRIVMSG $_[0] :       \n";
  450.         print $envia ":$nick_chan PRIVMSG $_[0] :COMANDOS               :Comentario \n";
  451.         print $envia ":$nick_chan PRIVMSG $_[0] :       \n";
  452.         print $envia ":$nick_chan PRIVMSG $_[0] :REGISTER               :Para registrar un canal \n";
  453.         print $envia ":$nick_chan PRIVMSG $_[0] :NICK           :Nick Help para mas informacion \n";
  454.         print $envia ":$nick_chan PRIVMSG $_[0] :SET                    :Fija opciones e informacion del canal \n";
  455.         print $envia ":$nick_chan PRIVMSG $_[0] :ACCESS                 :Modifica la lista de usuarios con privilegios \n";
  456.         print $envia ":$nick_chan PRIVMSG $_[0] :LEVELS                 :Redefine los niveles de acceso \n";
  457.         print $envia ":$nick_chan PRIVMSG $_[0] :AKICK                  :Mantiene la lista de Auto-Kick \n";
  458.         print $envia ":$nick_chan PRIVMSG $_[0] :DROP                   :Cancela la registracion de un canal \n";
  459.         print $envia ":$nick_chan PRIVMSG $_[0] :INFO                   :Muestra informacion de un canal \n";
  460.         print $envia ":$nick_chan PRIVMSG $_[0] :LIST                   :Lista los canales registrados \n";
  461.         print $envia ":$nick_chan PRIVMSG $_[0] :INVITE                 :Te invita a un canal \n";
  462.         print $envia ":$nick_chan PRIVMSG $_[0] :VOICE                  :Da voz en un canal \n";
  463.         print $envia ":$nick_chan PRIVMSG $_[0] :DEVOICE                :Quita voz en un canal \n";
  464.         print $envia ":$nick_chan PRIVMSG $_[0] :OP                     :Da OP en un canal \n";
  465.         print $envia ":$nick_chan PRIVMSG $_[0] :KICK                   :Kickea a un usuario de un canal \n";
  466.         print $envia ":$nick_chan PRIVMSG $_[0] :BAN                    :Poner un BAN en un canal \n";
  467.         print $envia ":$nick_chan PRIVMSG $_[0] :UNBAN                  :Quita un BAN en un canal \n";
  468.         print $envia ":$nick_chan PRIVMSG $_[0] :CLEAR                  :Reinicia los modos de un canal \n";
  469.         print $envia ":$nick_chan PRIVMSG $_[0] :RESET                  :Resetea el canal \n";
  470.         print $envia ":$nick_chan PRIVMSG $_[0] :DELACCESS              :Elimina nuestro registro de un canal \n";
  471.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  472.         print $envia ":$nick_chan PRIVMSG $_[0] :Note que si un canal no es utilizado por $chan_dias días ( es decir \n";
  473.         print $envia ":$nick_chan PRIVMSG $_[0] :qué ningún usuario en la lista de acceso del canal entra en \n";
  474.         print $envia ":$nick_chan PRIVMSG $_[0] :ese periodo de tiempo) será automaticamente cancelado. \n";
  475.         }
  476.         if($_[2] eq "SET")
  477.         {
  478.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: SET canal opción parámetros\n";                                        
  479.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";                                                
  480.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: Habilita al fundador del canal a definir varias opciones y\n";
  481.         print $envia ":$nick_chan PRIVMSG $_[0] :otra información. El fundador, debe identificarse vía\n";                          
  482.         print $envia ":$nick_chan PRIVMSG $_[0] :comando IDENTIFY antes de utilizar SET.\n";                            
  483.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";                                                  
  484.         print $envia ":$nick_chan PRIVMSG $_[0] :Opciones disponibles:\n";
  485.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  486.         print $envia ":$nick_chan PRIVMSG $_[0] :Opciones informativas \n";                                                  
  487.         print $envia ":$nick_chan PRIVMSG $_[0] :   DESC        Cambia la descripción del canal    \n";
  488.         print $envia ":$nick_chan PRIVMSG $_[0] :   URL         Asocia una URL al canal    \n";
  489.         print $envia ":$nick_chan PRIVMSG $_[0] :   EMAIL       Asocia una dirección de correo al canal   \n";
  490.         print $envia ":$nick_chan PRIVMSG $_[0] :   ENTRYMSG    Fija un mensaje que será mostrado a los usuarios cuando entren al canal\n";
  491.         print $envia ":$nick_chan PRIVMSG $_[0] :   TOPIC       Cambia el Tema del canal      \n";
  492.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  493.         print $envia ":$nick_chan PRIVMSG $_[0] :Opciones de seguridad \n";                
  494.         print $envia ":$nick_chan PRIVMSG $_[0] :   KEEPTOPIC   Retiene el tema (topic) cuando el canal no está en uso   \n";
  495.         print $envia ":$nick_chan PRIVMSG $_[0] :   TOPICLOCK   El Tema SOLO podrá ser cambiado vía SET TOPIC   \n";
  496.         print $envia ":$nick_chan PRIVMSG $_[0] :   DEBUG       Activa/desactiva la opción de que CHaN muestre determinadas \n";
  497.         print $envia ":$nick_chan PRIVMSG $_[0] :                    acciones sobre un canal.                \n";
  498.         print $envia ":$nick_chan PRIVMSG $_[0] :   MLOCK       Fija los modos del canal en 'ON' u 'OFF'   \n";
  499.         print $envia ":$nick_chan PRIVMSG $_[0] :   PRIVATE     Oculta el canal (no se ve cuando se utiliza el comando LIST)\n";
  500.         print $envia ":$nick_chan PRIVMSG $_[0] :   RESTRICTED  Restringe el acceso al canal\n";
  501.         print $envia ":$nick_chan PRIVMSG $_[0] :   SECURE      Activa los rasgos de seguridad de CHaN \n";
  502.         print $envia ":$nick_chan PRIVMSG $_[0] :   SECUREOPS   Control estricto de Status de operador \n";
  503.         print $envia ":$nick_chan PRIVMSG $_[0] :   AUTOLIMIT   Evita los ataques por MassJoin (clones) variando de forma automática y dinámica\n";
  504.         print $envia ":$nick_chan PRIVMSG $_[0] :                    el limite de usuarios de un canal (+l). \n";
  505.         print $envia ":$nick_chan PRIVMSG $_[0] :    \n";
  506.         print $envia ":$nick_chan PRIVMSG $_[0] :Opciones administrativas (solo fundadores)\n";
  507.         print $envia ":$nick_chan PRIVMSG $_[0] :   NAME        Ajusta el nombre del canal intercambiando mayúsculas y minúsculas\n";
  508.         print $envia ":$nick_chan PRIVMSG $_[0] :   FOUNDER     Cambia el fundador del canal \n";
  509.         print $envia ":$nick_chan PRIVMSG $_[0] :   SUCCESSOR   Cambia el sucesor del canal\n";
  510.         print $envia ":$nick_chan PRIVMSG $_[0] :   PASSWORD    Cambia la contraseña del fundador\n";
  511.         print $envia ":$nick_chan PRIVMSG $_[0] :   \n";
  512.         print $envia ":$nick_chan PRIVMSG $_[0] :Escriba /msg CHaN HELP <opción> para obtener mas \n";
  513.         print $envia ":$nick_chan PRIVMSG $_[0] :información de una opción en particular. \n";
  514.         }
  515.         if($_[2] eq "REGISTER")
  516.         {
  517.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: /msg $nick REGISTER <email> <contraseña> \n";
  518.         }
  519.         if($_[2] eq "ACCESS")
  520.         {
  521.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: \n";
  522.         print $envia ":$nick_chan PRIVMSG $_[0] :ACCESS canal ADD nick nivel \n";
  523.         print $envia ":$nick_chan PRIVMSG $_[0] :ACCESS canal DEL  {nick | posición-numero} \n";
  524.         print $envia ":$nick_chan PRIVMSG $_[0] :ACCESS canal LIST [máscara]Levels relacionados: \n";
  525.         print $envia ":$nick_chan PRIVMSG $_[0] :ACC-CHANGE ACC-LIST \n";
  526.         print $envia ":$nick_chan PRIVMSG $_[0] :Nivel por defecto: 450 y 0 respectivamente. \n";
  527.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: Mantiene la lista de accesos del canal.  La lista de accesos \n";
  528.         print $envia ":$nick_chan PRIVMSG $_[0] :establece qué usuarios están habilitados a ser operadores \n";
  529.         print $envia ":$nick_chan PRIVMSG $_[0] :del canal o acceder a comandos de CHaN en el canal.  Se pueden \n";
  530.         print $envia ":$nick_chan PRIVMSG $_[0] :establecer diferentes niveles de usuarios para acceder a\n";
  531.         print $envia ":$nick_chan PRIVMSG $_[0] :diferentes privilegios; utilice /msg CHaN HELP ACCESS LEVELS\n";
  532.         print $envia ":$nick_chan PRIVMSG $_[0] :para obtener información mas específica.  Cualquier nick que\n";
  533.         print $envia ":$nick_chan PRIVMSG $_[0] :no esté en la lista de acceso tiene nivel de usuario 0\n";
  534.         print $envia ":$nick_chan PRIVMSG $_[0] :(cero).\n";
  535.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  536.         print $envia ":$nick_chan PRIVMSG $_[0] :El comando ACCESS ADD agrega al nick con el nivel dado a la\n";
  537.         print $envia ":$nick_chan PRIVMSG $_[0] :lista de acceso; si el usuario ya existe en la lista, se\n";
  538.         print $envia ":$nick_chan PRIVMSG $_[0] :reemplazará su nivel.  El nivel especificado debe ser menor\n";
  539.         print $envia ":$nick_chan PRIVMSG $_[0] :que el que tiene el usuario que está ingresando el comando,\n";
  540.         print $envia ":$nick_chan PRIVMSG $_[0] :y si el nick está actualmente en la lista, el nivel actual\n";
  541.         print $envia ":$nick_chan PRIVMSG $_[0] :de dicho nick debe ser menor que el nivel del usuario que\n";
  542.         print $envia ":$nick_chan PRIVMSG $_[0] :está ingresando el comando.\n";
  543.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  544.         print $envia ":$nick_chan PRIVMSG $_[0] :El comando ACCESS DEL elimina un usuario de la lista de\n";
  545.         print $envia ":$nick_chan PRIVMSG $_[0] :accesos.  Se puede eliminar un usuario ingresando el nick o\n";
  546.         print $envia ":$nick_chan PRIVMSG $_[0] :ingresando el número que ocupa en la lista de accesos.\n";
  547.         print $envia ":$nick_chan PRIVMSG $_[0] :\n";
  548.         print $envia ":$nick_chan PRIVMSG $_[0] :El comando ACCESS LIST muestra la lista de accesos al canal;\n";
  549.         print $envia ":$nick_chan PRIVMSG $_[0] :se pueden utilizar caracteres comodines o máscaras, en cuyo\n";
  550.         print $envia ":$nick_chan PRIVMSG $_[0] :caso sólo las coincidencias concurrentes serán listadas.\n";
  551.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  552.         print $envia ":$nick_chan PRIVMSG $_[0] :Nota: Una máscara es el sistema que utiliza el IRC para identificar a\n";
  553.         print $envia ":$nick_chan PRIVMSG $_[0] :un usuario, esta compuesta de nick!ident\@host, donde nick es el \n";
  554.         print $envia ":$nick_chan PRIVMSG $_[0] :nick del usuario, ident es el ident y host es la ip virtual. \n";
  555.         print $envia ":$nick_chan PRIVMSG $_[0] :Los caracteres ! y @ son los separadores de los respectivos campos. \n";
  556.         print $envia ":$nick_chan PRIVMSG $_[0] :Una máscara acepta caracteres  \"comodín\" que son el * que sustituye \n";
  557.         print $envia ":$nick_chan PRIVMSG $_[0] :cualquier numero de caracteres en su posición y ? que sustituye un único carácter.:\n";
  558.         }
  559.         if ($_[2] eq "LEVELS")
  560.         {
  561.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: \n";
  562.         print $envia ":$nick_chan PRIVMSG $_[0] :          LEVELS canal SET tipo nivel\n";
  563.         print $envia ":$nick_chan PRIVMSG $_[0] :          LEVELS canal {DIS | DISABLE} tipo\n";
  564.         print $envia ":$nick_chan PRIVMSG $_[0] :          LEVELS canal LIST\n";
  565.         print $envia ":$nick_chan PRIVMSG $_[0] :          LEVELS canal RESET\n";
  566.         print $envia ":$nick_chan PRIVMSG $_[0] :  \n";
  567.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: El comando LEVELS permite un control fino sobre los accesos\n";
  568.         print $envia ":$nick_chan PRIVMSG $_[0] :numéricos utilizados por los canales.  Con este comando,\n";
  569.         print $envia ":$nick_chan PRIVMSG $_[0] :usted puede definir los niveles requeridos para muchas de\n";
  570.         print $envia ":$nick_chan PRIVMSG $_[0] :las funciones de CHaN.  Los comandos SET FOUNDER,\n";
  571.         print $envia ":$nick_chan PRIVMSG $_[0] :SET PASSWORD, así como éste comando están siempre\n";
  572.         print $envia ":$nick_chan PRIVMSG $_[0] :restringidos al fundador.\n";
  573.         print $envia ":$nick_chan PRIVMSG $_[0] :LEVELS SET habilita el acceso para una función o grupo de\n";
  574.         print $envia ":$nick_chan PRIVMSG $_[0] :funciones a ser modificadas.\n";
  575.         print $envia ":$nick_chan PRIVMSG $_[0] :LEVELS DISABLE (o DIS en forma abreviada) deshabilita un\n";
  576.         print $envia ":$nick_chan PRIVMSG $_[0] :privilegio automático, o deshabilita el acceso para\n";
  577.         print $envia ":$nick_chan PRIVMSG $_[0] :cualquier otro que no sea el fundador del canal.\n";
  578.         print $envia ":$nick_chan PRIVMSG $_[0] :LEVELS LIST muestra los niveles actuales para cada función o\n";
  579.         print $envia ":$nick_chan PRIVMSG $_[0] :grupo de funciones.\n";
  580.         print $envia ":$nick_chan PRIVMSG $_[0] :LEVELS RESET vuelve todos los niveles a sus valores por\n";
  581.         print $envia ":$nick_chan PRIVMSG $_[0] :defecto, los mismos que cuando se registra por primera vez\n";
  582.         print $envia ":$nick_chan PRIVMSG $_[0] :un canal (vea HELP ACCESS LEVELS).\n";
  583.         print $envia ":$nick_chan PRIVMSG $_[0] :  \n";
  584.         print $envia ":$nick_chan PRIVMSG $_[0] :Para una lista de las funciones que pueden ser establecidas,\n";
  585.         print $envia ":$nick_chan PRIVMSG $_[0] :utilice el comando HELP LEVELS DESC.\n";
  586.         }
  587.         if ($_[2] eq "AKICK")
  588.         {
  589.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis:\n";
  590.         print $envia ":$nick_chan PRIVMSG $_[0] :         AKICK canal ADD máscara [razón]\n";
  591.         print $envia ":$nick_chan PRIVMSG $_[0] :         AKICK canal DEL máscara\n";
  592.         print $envia ":$nick_chan PRIVMSG $_[0] :         AKICK canal LIST [máscara]\n";
  593.         print $envia ":$nick_chan PRIVMSG $_[0] :         \n";
  594.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: \n";
  595.         print $envia ":$nick_chan PRIVMSG $_[0] :Definimos AKICK como \"Expulsión automática\".\n";
  596.         print $envia ":$nick_chan PRIVMSG $_[0] :Definimos BAN como \"Entrada prohibida\".\n";
  597.         print $envia ":$nick_chan PRIVMSG $_[0] :  \n";
  598.         print $envia ":$nick_chan PRIVMSG $_[0] :Este comando, mantiene la lista de AKICK del canal.  Si un\n";
  599.         print $envia ":$nick_chan PRIVMSG $_[0] :usuario está en la lista de AKICK e intenta entrar al canal,\n";
  600.         print $envia ":$nick_chan PRIVMSG $_[0] :CHaN automáticamente agrega dicho usuario a la lista BAN\n";
  601.         print $envia ":$nick_chan PRIVMSG $_[0] :del canal, y luego lo expulsa del canal.\n";
  602.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  603.         print $envia ":$nick_chan PRIVMSG $_[0] :El comando AKICK ADD agrega un usuario a la lista de AKICK.\n";
  604.         print $envia ":$nick_chan PRIVMSG $_[0] :Si una razón es dada con el comando, entonces la razón será\n";
  605.         print $envia ":$nick_chan PRIVMSG $_[0] :utilizada por CHaN cuando expulse a dicho usuario; si\n";
  606.         print $envia ":$nick_chan PRIVMSG $_[0] :no, el mensaje que se utilizará por defecto, es \n";
  607.         print $envia ":$nick_chan PRIVMSG $_[0] :\"No te quiero en el canal\".\n";
  608.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  609.         print $envia ":$nick_chan PRIVMSG $_[0] :El comando AKICK DEL elimina al usuario de la lista de\n";
  610.         print $envia ":$nick_chan PRIVMSG $_[0] :AKICK.  Este comando no remueve el BAN que pueda existir en\n";
  611.         print $envia ":$nick_chan PRIVMSG $_[0] :el canal, el cual deberá ser removido manualmente.\n";
  612.         print $envia ":$nick_chan PRIVMSG $_[0] :\n";
  613.         print $envia ":$nick_chan PRIVMSG $_[0] :El comando AKICK LIST muestra la lista de usuarios en la\n";
  614.         print $envia ":$nick_chan PRIVMSG $_[0] :lista de AKICK.  Opcionalmente, sólo lista aquellos\n";
  615.         print $envia ":$nick_chan PRIVMSG $_[0] :suministrados con la máscara dada.\n";
  616.         print $envia ":$nick_chan PRIVMSG $_[0] :  \n";
  617.         print $envia ":$nick_chan PRIVMSG $_[0] :Nota: Una máscara es el sistema que utiliza el IRC para identificar a \n";
  618.         print $envia ":$nick_chan PRIVMSG $_[0] :un usuario, esta compuesta de nick!ident\@host, donde nick es el \n";
  619.         print $envia ":$nick_chan PRIVMSG $_[0] :nick del usuario, ident es el ident y host es la ip virtual. \n";
  620.         print $envia ":$nick_chan PRIVMSG $_[0] :Los caracteres ! y @ son los separadores de los respectivos campos. \n";
  621.         print $envia ":$nick_chan PRIVMSG $_[0] :Una máscara acepta caracteres \"comodín\" que son el * que sustituye \n";
  622.         print $envia ":$nick_chan PRIVMSG $_[0] :cualquier número de caracteres en su posición y ? que sustituye un único carácter. \n";
  623.         }
  624.         if ($_[2] eq "INFO")
  625.         {
  626.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: INFO canal\n";
  627.         print $envia ":$nick_chan PRIVMSG $_[0] : \n";
  628.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: Provee información acerca del canal (o informa que no está\n";
  629.         print $envia ":$nick_chan PRIVMSG $_[0] :registrado).  Lista el fundador, hora y fecha de\n";
  630.         print $envia ":$nick_chan PRIVMSG $_[0] :registro, última vez que se utilizó, descripción, opciones y\n";
  631.         print $envia ":$nick_chan PRIVMSG $_[0] :modos del canal (si los hubiese).\n";
  632.         }
  633.         if ($_[2] eq "INVITE")
  634.         {
  635.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: INVITE canal\n";
  636.         print $envia ":$nick_chan PRIVMSG $_[0] :  \n";
  637.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: Le dice a CHaN que lo invite a usted al canal indicado.\n";
  638.         print $envia ":$nick_chan PRIVMSG $_[0] :Por defecto, solo funciona si su nivel de acceso en dicho\n";
  639.         print $envia ":$nick_chan PRIVMSG $_[0] :canal es mayor que 0 (cero).\n";
  640.         }
  641.         if ($_[2] eq "OP")
  642.         {
  643.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: OP #canal nick\n";
  644.         print $envia ":$nick_chan PRIVMSG $_[0] :  \n";
  645.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: Convierte en Operador al usuario indicado en el canal indicado.  \n";
  646.         print $envia ":$nick_chan PRIVMSG $_[0] :Por defecto, está limitado a quienes posean nivel 5 o mayor en el canal.\n";
  647.         }
  648.         if ($_[2] eq "DEOP")
  649.         {
  650.         print $envia ":$nick_chan PRIVMSG $_[0] :Sintaxis: DEOP #canal nick\n";
  651.         print $envia ":$nick_chan PRIVMSG $_[0] :Uso: Quita el estado de Operador (@) al usuario indicado en el canal indicado.  \n";
  652.         print $envia ":$nick_chan PRIVMSG $_[0] :Tan solo puede usarse sobre nicks con un nivel en el canal inferior al del nick \n";
  653.         print $envia ":$nick_chan PRIVMSG $_[0] :que ejecuta el comando.\n";
  654.         }
  655. }
  656.  
  657. #creg todas las funciones
  658.  
  659. sub creg
  660. {
  661.         if ($_[1] eq "REGISTER")
  662.         {
  663.         my $canal = $_[2];
  664.         my $pass = $_[3];
  665.         my $descripcion = $_[4];
  666.         my $nick_register_creg = $_[0];
  667.         &creg_register("$nick_register_creg","$_[1]","$canal","$pass","$descripcion");
  668.         }
  669.         elsif ($_[1] eq "HELP")
  670.         {
  671.         &creg_help("$_[0]","$_[2]");
  672.         }
  673.         elsif ($_[1] eq "LIST")
  674.         {
  675.         &creg_list("$_[0]","$_[2]");
  676.         }
  677.         elsif ($_[1] eq "ACEPTA")
  678.         {
  679.         &creg_acepta("$_[0]","$_[2]");
  680.         }
  681. }
  682.  
  683. sub creg_acepta
  684. {
  685. my($elnick);
  686. my($elcanal);
  687. $elnick = $_[0];
  688. $elcanal = $_[1];
  689. my($mira_cregacepta);
  690. my(@mira_creglist);
  691. my($mira_datos_creglist);
  692. my(@cregacepta_separa);
  693. my ($com_cregacepta);
  694. $com_cregacepta = "no";
  695. $mira_cregacepta = exists($ircop{$elnick});
  696.         if ($mira_cregacepta == 1)
  697.         {
  698.         open(cregmira,"<register.txt");
  699.         @mira_creglist =<cregmira>;
  700.                 foreach $mira_datos_creglist(@mira_creglist)
  701.                 {
  702.                 @cregacepta_separa = split(" ",$mira_datos_creglist);
  703.                         if ($cregacepta_separa[0] eq $elcanal)
  704.                         {
  705.                         close(cregmira);
  706.                         open(cregacepta,">$elcanal.txt");
  707.                         print cregacepta "CANAL $elcanal \n";
  708.                         print cregacepta "PASS $cregacepta_separa[1] \n";
  709.                         print cregacepta "FUNDER $cregacepta_separa[2] \n";
  710.                         print cregacepta "DESCRIPCION $cregacepta_separa[3]\n";
  711.                         print cregacepta "TOPIC $cregacepta_separa[3] \n";
  712.                         print cregacepta "MODO rnt \n";
  713.                         print cregacepta "\n";
  714.                         print cregacepta "AKICK \n";
  715.                         print cregacepta "\n";
  716.                         print cregacepta "ACCESS \n";
  717.                         print cregacepta "$elnick 501\n";
  718.                         close(cregacepta);
  719.                         $com_cregacepta = "si";
  720.                         print $envia ":$nick_creg PRIVMSG $elnick :Canal registrado con exito \n";
  721.                         print $envia ":$nick_creg JOIN $elcanal \n";
  722.                         print $envia ":$nick_creg MODE $elcanal +rnt \n";
  723.                         print $envia ":$nick_creg PART $elcanal \n";
  724.                         }
  725.                 }
  726.                 &creg_borra_register($elcanal);
  727.                 if ($com_cregacepta ne "si")
  728.                 {
  729.                 &error("$elnick","error_creg_acepta","$elcanal")
  730.                 }
  731.         }
  732.                
  733.                
  734. }
  735.  
  736. sub creg_borra_register
  737. {
  738. my (@registros,@new_registros);
  739.  
  740. open (DATABASE, "<register.txt") || &error('abrir','archivo');
  741. flock (DATABASE,1)||&error('lock','file');
  742. @registros = <DATABASE>;
  743. close (DATABASE) || &error('cerrar','archivo');
  744.         foreach $registro (@registros)
  745.         {
  746.         $registro =~ s/\n//g;
  747.         my(@borra_datos_register) = split(" ",$registro);
  748.                 if ($borra_datos_register[0] != $_[0])
  749.                 {
  750.                 push (@new_registros,$registro);
  751.                 }
  752.         }
  753. open (DATABASE, ">register.txt") || &error('abrir','archivo');
  754. flock (DATABASE,2)||&error('lock','file');
  755.         foreach $new_registro (@new_registros)
  756.         {
  757.         print DATABASE "$new_registro\n";
  758.         }
  759. close (DATABASE) || &error('cerrar','archivo');
  760. }
  761.  
  762.  
  763.  
  764. sub creg_list
  765. {
  766. my($mira_list);
  767. my(@creg_list);
  768. my ($datos_creg_list);
  769. $mira_list = exists($ircop{$_[0]});
  770.         if ($mira_list == 1)
  771.         {
  772.         open(creglist,"<register.txt");
  773.         @creg_list =<creglist>;
  774.                 foreach $datos_creg_list(@creg_list)
  775.                 {
  776.                 @separa_list_creg = split(" ",$datos_creg_list);
  777.                 print $envia ":$nick_creg PRIVMSG $_[0] :Lista de canales a la espera de aceptar registro : \n";
  778.                 print $envia ":$nick_creg PRIVMSG $_[0] : \n";
  779.                 print $envia ":$nick_creg PRIVMSG $_[0] :Nombre del canal:      $separa_list_creg[0] \n";
  780.                 print $envia ":$nick_creg PRIVMSG $_[0] :Descripcion:           $separa_list_creg[3]\n";
  781.                 print $envia ":$nick_creg PRIVMSG $_[0] :Nick que lo registra:  $separa_list_creg[2]\n";
  782.                 }
  783.         }
  784.         close(creglist);
  785. }
  786.  
  787. sub creg_register
  788. {
  789. my($lee_register_temp);
  790. my(@register_mira);
  791. my($comprueba);
  792. $comprueba = "no";
  793. my(@creg_register);
  794. open(leecreg,"<register.txt");
  795. @creg_register =<leecreg>;
  796.         foreach $lee_register_temp(@creg_register)
  797.         {
  798.         @register_mira = split(" ",$lee_register_temp);
  799.                 if ($register_mira[0] eq $_[2])
  800.                 {
  801.                 &error("$_[0]","error_canal_registrado","$_[2]");
  802.                 $comprueba = "si";
  803.                 close(leecreg);
  804.                 }
  805.         }
  806.         if ($comprueba eq "no")
  807.         {
  808.         open(leecreg,">>register.txt");
  809.         print leecreg "$_[2] $_[3] $_[0] $_[4]  \n";
  810.         close(leecreg);
  811.         print $envia ":$nick_creg PRIVMSG $_[0] :El canal $_[2] esta a la espera de ser aceptado,bajo el nick de $_[0] y la contraseña $_[3] ,gracias \n"
  812.         }
  813. }
  814.  
  815.  
  816. #funciones de error
  817. sub error
  818. {
  819.         if ($_[1] eq "error_canal_registrado")
  820.         {
  821.         print $envia ":$nick_creg PRIVMSG $_[0] :Lo sentimos, el canal $_[2] ya estaba registrado \n"
  822.         }
  823.         if ($_[1] eq "error_creg_acepta")
  824.         {
  825.         print $envia ":$nick_creg PRIVMSG $_[0] :ERROR: El canal $_[2] no esta a la espera de ser aceptado \n";
  826.         }
  827. }
Coloreado en 0.021 segundos, usando GeSHi 1.0.8.4


Tendrá muchos fallos , pero fue mi primer proyecto (hace un mes).
¡Saludos!
Avatar de Usuario
ubuntu
Perlero nuevo
Perlero nuevo
 
Mensajes: 18
Registrado: 2009-08-19 07:30 @354


Volver a Intermedio

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 3 invitados

cron