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;