Discussion utilisateur:Denis Dordoigne/Modifications récentes

Ce premier projet de suivi en direct des modifications récentes est obsolète et n'est plus maintenu (voir la page d'explication pour l'histoire)

© Denis Dordoigne, avril 2005 Modèle:GPL

#!/usr/bin/perl -w

use Net::IRC;
use strict;
use Encode;

my $irc = new Net::IRC;

# repertoire des logs
my $replog='/tmp';


# connexion vers le serveur a propager
my $irc_cx = $irc->newconn
    (
     Server   => 'irc.wikimedia.org',
     Nick     => 'passerelle'
     );

# canal a copier
my $chan = '#fr.wikipedia';


# connexion vers le serveur bitlbee
my $bitlbee_cx = $irc->newconn
    (
     Server   => 'localhost',
     Nick     => 'bitlebot'
     );

# mot de passe sur bitlbee
my $bitlbee_passwd = "tu me crois assez distrait pour le laisser ?";


# numero de compte des connexions
my %bitlbee_con = 
(
    JABBER => 2,
    YAHOO  => 0,
    MSN    => 1
 );

# liste des bots déclarés le 12/04/2006
my @bots = ('AlphaBot','Badmood','Chlewbot','Chobot','CyeZBot','DasBot','Diderobot','Eskimbot','Fabbot','FlaBot','Gpvosbot','HasharBot','Hexabot','KocjoBot','Koyuki','Loveless','MMBot','MagnetiK-BoT','MedBot','MisterMatt','MoriBot','Orthogaffe','PieRRoBoT','Probot','Robbot','RobotE','RobotQuistnix','SashatoBot','Solbot','StéBot','Ugur','YurikBot','Zwobot');


# listes d'utilisateurs de la passerelle
my @receivers_ip;  # recoivent les contributions d'ip
my @receivers_bot; # recoivent les contributions de bots
my @receivers_usr; # recoivent les contributions d'utilisateurs enregistres


# renvoie la position d'un element dans un tableau de chaines
sub array_find
{
    # arguments : ref de tableau, element a trouver
    my ($arrayref, $elt) = @_;

    # on parcourt le tableau jusqu'à que l'element soit trouve
    my $i = 0;
    for ( my $i = 0; $i < @$arrayref ; $i++)
    {
	return $i if ($$arrayref[$i] eq $elt)
    }

    # l'element n'etait pas dans le tableau, on renvoie -1
    return -1;
}


# ajoute un element dans un tableau de chaines en evitant les doublons
sub array_add
{
    # arguments : ref de tableau, element a ajouter
    my ($arrayref, $elt) = @_;
    
    # on sort si l'element est deja dans le tableau
    return 0 if (-1 != array_find($arrayref, $elt));
    
    # on ajoute l'element au tableau
    return push(@$arrayref, $elt);
}

# enleve un element d'un tableau de chaines
sub array_remove
{
    # arguments : ref de tableau, element a trouver
    my ($arrayref, $elt) = @_;
    
    # on recupere l'indice de l'element dans le tableau
    my $pos = array_find($arrayref, $elt);

    # on sort si l'element n'est pas dans le tableau
    return 0 if ($pos == -1);
    
    # on supprime l'element du tableau
    return splice(@$arrayref, $pos, 1);
}


sub loguer
{
    my $jour    = substr("0".(localtime)[3],-2);
    my $mois    = substr("0".((localtime)[4]+1),-2);
    my $heure   = substr("0".(localtime)[2],-2);
    my $minutes = substr("0".(localtime)[1],-2);
    
    open FICLOG,">>$replog/$_[0].log" or return;
    print FICLOG "[$jour/$mois $heure:$minutes] $_[1]\n";
    close FICLOG;
}

# Evenement: connexion reussie a bitlbee
sub on_bitlbee_connect
{
    my $self = shift;
    
    # on rejoint le canal bitlbee
    $self->join('&bitlbee');

    # on s'identifie
    $self->privmsg('&bitlbee', "identify $bitlbee_passwd");
        
    # on remplit le log de connexions
    &loguer("connexion","Session debut bitlbee");
}

# Evenement: connexion reussie a irc
sub on_irc_connect
{
    my $self = shift;
    
    # on rejoint le canal irc a copier
    $self->join($chan);
    
    # on remplit le log de connexions
    &loguer("connexion","Session debut irc");
}



# Evenement: Message recu par messagerie
sub on_msg
{
    my ($self, $event) = @_;
    my $nick = $event->nick;
    my ($requete) = ($event->args);

    # reponse type aux distraits
    my $reponse = 'demande incomprise ou inutile';
    
    # on ignore la casse
    $requete = lc($requete);

    
    ### "stop" -> arret du suivi
    if ($requete eq 'stop')
    {
	# retrait de toutes les listes
	array_remove(\@receivers_bot, $nick);
	array_remove(\@receivers_ip, $nick);
	array_remove(\@receivers_usr, $nick);

	$reponse = 'taper "bot+", "usr+" ou "ip+" pour reprendre';
    }


    ### "bot+" -> ajout du suivi des bots
    elsif ($requete eq 'bot+')
    {
	$reponse = 'les bots sont maintenant suivis'
	    if (array_add(\@receivers_bot, $nick))
    }

    ### "bot-" -> arret du suivi des bots
    elsif ($requete eq 'bot-')
    {
	$reponse = 'les bots ne sont plus suivis'
	    if (array_remove(\@receivers_bot, $nick));
    }

    ### "ip+" -> ajout du suivi des ip
    elsif ($requete eq 'ip+')
    {
	$reponse = 'les ip sont maintenant suivies'
	    if (array_add(\@receivers_ip, $nick))
    }

    ### "ip-" -> arret du suivi des ip
    elsif ($requete eq 'ip-')
    {
	$reponse = 'les ip ne sont plus suivies'
	    if (array_remove(\@receivers_ip, $nick));
    }


    ### "usr+" -> ajout du suivi des utilisateurs enregistres
    elsif ($requete eq 'usr+')
    {
	$reponse = 'les utilisateurs enregistres sont maintenant suivis'
	    if (array_add(\@receivers_usr, $nick))
    }

    ### "usr-" -> arret du suivi des utilisateurs enregistres
    elsif ($requete eq 'usr-')
    {
	$reponse = 'les utilisateurs enregistres ne sont plus suivis'
	    if (array_remove(\@receivers_usr, $nick));
    }

    # on logue le message et sa reponse
    &loguer("messages","$nick: $requete\n\t->$reponse");
    
    # on envoie la reponse
    $self->privmsg($nick, $reponse);
}



# Evenement: Message sur le canal surveille
sub on_irc_msg
{
    my ($self, $event) = @_;
    my ($text) = ($event->args);

    # reference vers le tableau des destinataires
    my $receivers;
    
    # on supprime les couleurs
    $text =~ s!\003\d{0,2}!!g;

    # on recode en latin1
    Encode::from_to($text, "UTF-8", 'iso-8859-1');

    # on recupere le nom du wikipedien ayant fait la modification
    my ($wikipedien) = ($text =~ / \* (.+?) \* /);

    # il s'agit d'un bot, on transmet aux interesses
    if (array_find(\@bots, $wikipedien) != -1)
    {
	$receivers = \@receivers_bot;
    }
    
    # il s'agit d'une ip (ou ressemblant)
    elsif ($wikipedien =~ /^[0-9.]+$/)
    {
	$receivers = \@receivers_ip;
    }

    # il s'agit d'un utilisateur enregistre
    else
    {
	$receivers = \@receivers_usr;
    }

    # on transmet le texte aux concernes
    foreach my $receiver (@$receivers)
    {
	$bitlbee_cx->privmsg($receiver, $text);
    }
}

# Evenement: Message sur le canal bitlbee
sub on_bitlbee_msg
{
    my ($self, $event) = @_;
    my ($text) = ($event->args);

    # si c'est une requete, on l'accepte
    if ($text =~ /New request/)
    {
	$self->privmsg('&bitlbee', 'yes');
    }

    # si c'est un message d'utilisateur inconnu, on ajoute celui-ci
    elsif ($text =~ /^([A-Z]+) - Message from unknown handle (.+?):$/)
    {
	my ($protocole, $user) = ($1, $2);

	# on recupere le numero de compte pour ce protocole
	my $account_number = $bitlbee_con{$protocole};

	# on ajoute l'utilisateur
	$self->privmsg('&bitlbee', "add $account_number $user");
	    

	# on remplit le log des utilisateurs
	&loguer('utilisateurs',"ajout de $user ($protocole)");
    }

    else
    {
	# on remplit le log de messages de bitlbee
	&loguer("bitlbee",$text);
    }
}


# Evenement: quelqu'un rejoint le canal bitlbee
sub on_bitlbee_join
{
    my ($self, $event) = @_;
    my $nick = $event->nick;

    # on ignore root et soi-meme
    return if ($nick eq 'root' || $nick eq $self->nick);

    # on l'ajoute aux recepteurs par defaut
    array_add(\@receivers_ip, $nick);
    array_add(\@receivers_usr, $nick);

    # on remplit le log des utilisateurs
    &loguer('utilisateurs',"arrivee de $nick");
}

# Evenement: quelqu'un quitte le canal bitlbee
sub on_bitlbee_part
{
    my ($self, $event) = @_;
    my $nick = $event->nick;

    # on l'enleve des listes de recepteurs
    array_remove(\@receivers_bot, $nick);
    array_remove(\@receivers_ip, $nick);
    array_remove(\@receivers_usr, $nick);
    

    # on remplit le log des utilisateurs
    &loguer('utilisateurs',"depart de $nick");
}


# Connexion irc morte
sub on_irc_disconnect
{
    &loguer('connexion', 'irc mort');
    # on tente un retour
    $irc_cx->connect();
}

# Connexion morte
sub on_bitlbee_disconnect
{
    &loguer('connexion', 'bitlbee mort');
}

$irc_cx->add_handler('public', \&on_irc_msg);
$bitlbee_cx->add_handler('public', \&on_bitlbee_msg);

$irc_cx->add_handler('disconnect', \&on_irc_disconnect);
$irc_cx->add_handler(376, \&on_irc_connect);

$bitlbee_cx->add_handler('disconnect', \&on_bitlbee_disconnect);
$bitlbee_cx->add_handler(376, \&on_bitlbee_connect);

$bitlbee_cx->add_handler('join', \&on_bitlbee_join);
$bitlbee_cx->add_handler('quit', \&on_bitlbee_part);
$bitlbee_cx->add_handler('msg', \&on_msg);

$irc->start;