Service geofront (perl)

Description

Bonjour à tous. Voici ma première source : un robot géofront rédigé en perl destiné à ceux qui souhaitent administrer leur serveur irc. Il est conçu pour fonctionner en tant que service sous les démons UNREALIRCD. N'hesitez pas à faire des modifications, ce robot est loin d'être parfait. La programation mIRC me semblant être bien trop omniprésente sur ce site, j'espère que cela montrera à ceux qui débutent que ce n'est pas le seul moyen de coder des bots. Plus d'informations dans le readme.

Source / Exemple :


#!/usr/bin/perl

####################################################
#			      SiNuZoiD						   #
# Service Géofront par iZy_TeH_PariaH			   #
# Version : 1.0							           #
# Testé sur Ubuntu                                 #
# Plus d'informations dans le readme               #
####################################################

use IO::Socket;
use Digest::SHA1 qw(sha1 sha1_hex sha1_base64);
use threads;
#--main
my ($addr,$port,$nick,$pass)  = @ARGV;
die ('Syntaxe : .pl addr port nick pass*') if (!defined($nick));
my %admin; #tableau de hachage contenant la liste Username -> Password
load_axx();
my %blacklist;#blacklist 1 = AKICK
my %conf; #table de hachage contenant la liste des configurations fixées
$conf{"IDENT"} = undef; #Identifiant à bloquer [Kill quand le pseudo match]
$conf{"ANTIPUB"} = 0; # 0 = pas d'antipub / 1 = Kick sur pub / 2 = KiLL sur pub / 3 = G-LINE sur pub
$conf{"SMODE"} = undef;
$conf{"UCHAN"} = "#Services";
$conf{"GEO_HOST"} = "Geofront.fr";
$conf{"SERV_ADMIN_HOST"} = "ServiceAdmin.fr";
print "-------- SinuZoiD Geofront Service ------------\n";
print "UCHAN : ".$conf{"UCHAN"}."\n";
print "GEO_HOST : ".$conf{"GEO_HOST"}."\n";
print "SERV_ADMIN_HOST : ".$conf{"SERV_ADMIN_HOST"}."\n";
print "Connection à $addr ($port)... Nick : $nick\n";

my $sock = IO::Socket::INET->new(proto => 'tcp', #Socket de connection au serveur IRC
								 PeerAddr => $addr,
								 PeerPort => $port);
								 
my ($ans,$raw);
connection_serv($nick,$sock,$pass); #Connection au serveur
while ($raw = <$sock>){ #Comunication avec le serveur
	$ans = uncolor_raw($raw);
	my $type = get_type($ans); #Récupération du type de requête
	on_ping($ans,$sock) if ($type =~ /PING/);
	on_join($ans,$sock) if ($type =~ /\sJOIN\s/);
	on_privmsg($ans,$sock,$nick,%admin) if ($type =~ /\sPRIVMSG\s/);
	on_quit($ans,$sock) if ($type =~ /\sQUIT\s/);
	on_part($ans,$sock) if ($type =~ /\sPART\s/);
	on_mode($ans,$sock) if ($type =~/\sMODE\s/);
	on_notice($ans,$sock) if ($type =~ /\sNOTICE\s/);
	on_raw_378($ans,$sock) if ($type =~ /\s378\s/); #whois IP - real hostname
	on_raw_311($ans,$sock) if ($type =~ /\s311\s/); #whois is pseudo usrname hostname
	on_raw_318($ans,$sock) if ($type =~ /\s318\s/); #end of /whois
}
#--Administration MESSAGE PRIVÉ
sub order_join{
	my ($sock,$nick,$raw) = @_;
	my ($w1,$w2) = ($raw =~ /^(\S+)\s+(\S+)/);
	
	if (!defined($w2)){
		send_notice($nick, "Erreur de syntaxe : join #CANAL",$sock);
		return 0;
	}
	send_notice($nick,"Joining $w2...",$sock);
	join_c($w2,$sock);
};
sub order_quit{
	my ($sock, $nick,$raw) = @_;
	send_notice($nick,"Déconnection du serveur...\n",$sock);
	print $sock "QUIT :Rebooting Service...\r\n";
};
sub order_mod_axx{
	my ($sock,$nick,$raw) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /^(\S+)\s+(\S+)\s+(\S+)/);
	if (!defined($w3)){
		send_notice($nick, "Erreur de syntaxe : modify AncienPass NouveauPass",$sock);
		return 0;
	}
	$nick =~ tr/A-Z/a-z/;
	chomp $w3;
	my $sha1 = sha1_hex($w2); 
	if ($admin{$nick} eq $sha1){
		my $bool = 0;
		my $new_pass = sha1_hex($w3);
		open FIC, "root_axx.conf";
		my @fic = <FIC>;
		close FIC;
		foreach $entry (@fic){
			if($entry =~ /^$nick\s/i){
				$entry = "$nick $new_pass\n";
				$bool = 1;
				break;
			}
		}
		if ($bool == 1){
			open FIC, ">root_axx.conf";
			foreach $entry (@fic){
				print FIC "$entry";
			}
			close FIC;
			send_notice($nick, "Votre nouveau mot de passe est désormais $w3.",$sock);
			load_axx();
		}
		else{
			send_notice($nick, "Entrée non trouvée.",$sock);
		}
	return 0;
	}
	else{
		send_notice($nick,"Mot de passe incorrect !",$sock);
	}
};
sub order_rem_axx{
	my ($sock,$nick,$raw) = @_;
	my ($w1,$w2) = ($raw =~ /^(\S+)\s+(\S+)/);
	if (!defined($w2)){
		send_notice ($nick, "Erreur de syntaxe : remove PSEUDO",$sock);
		return 0;
	}
	chomp $w2;
	open FIC,"root_axx.conf";
	my @fic = <FIC>;
	my $bool = 0;
	close FIC;
	foreach $entry (@fic){
		if($entry =~ /^$w2\s/i){
			$entry = "";
			$bool = 1;
			break;
		}
	}
	if($bool == 1){
		open FIC, ">root_axx.conf";
		foreach $entry (@fic){
			print FIC "$entry";
		}
		close FIC;
		send_notice($nick, "Base de donnée modifiée.",$sock);
		load_axx();
		log_actions("$nick REMOVES the geofront account of $w2");
	}
	else{
		send_notice ($nick,"Entrée non trouvée.",$sock);
	}
	return 0;
};
sub order_add_axx{
	my ($sock,$nick,$raw) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /^(\S+)\s+(\S+)\s+(\S+)/);
	if (!defined($w3)){
		send_notice($nick,"Erreur de syntaxe : add PSEUDO PASS",$sock);
		return 0;
	}
	open FIC,"root_axx.conf";
	@fic = <FIC>;
	close FIC;
	chomp $w3;
	my $sha1 = sha1_hex($w3);
	foreach (@fic){
		my ($usr,$pass) = ($_ =~ /^(\S*)\s(\S*)/);
		if ($w2 =~ /^$usr$/i){
			send_notice($nick,"$w2 est déjà inscrit dans la base de données. Utilisez la commande \"modify\" pour en modifier l'entrée",$sock);
			return 0;
		}
	}
	open FIC, ">>root_axx.conf";
	print FIC "$w2 $sha1\n";
	close FIC;
	send_notice($nick,"L'utilisateur $w2 à été inscrit dans la base de données. Son mot de passe est désormais $w3.",$sock);
	load_axx();
	log_actions("$nick ADDS a geofront account for $w2");
	return 0;
};
sub order_self_unban{
	my ($sock,$nick,$raw,$mask) = @_;
	my ($w1,$w2) = ($raw =~ /^(\S+)\s+(\S+)/);
	if (!defined($w2)){
		send_notice($nick,"Erreur de syntaxe : unban chan",$sock);
	}
	else{
		change_mode("-b",$w2,$sock,$mask);
		send_notice($nick,"Requête effectuée",$sock);
	}
};
sub order_oper{
	my ($sock,$nick,$raw) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /^(\S+)\s+(\S+)\s+(\S+)/);
	if (!defined($w3)){
		send_notice($nick,"Erreur de syntaxe : oper <username> <oper_password>",$sock);
	}
	else{
		print $sock "OPER $w2 $w3\r\n";
	}
};
sub order_set_mode{
	my ($sock, $nick, $raw) = @_;
	my ($w1, $w2, $w3) = ($raw =~ /^(\S+)\s+(\S+)\s+(\S+)/);
	if (!defined ($w3)){
		send_notice($nick, "Erreur de syntaxe : mode <target> <mode>",$sock);
	}
	else{
		change_mode($w3,$w2,$sock);
		send_notice($nick,"Requête effectuée",$sock);
	}
};
sub order_part{
	my ($sock,$nick,$raw) = @_;
	my ($w1,$w2) = ($raw =~ /^(\S+)\s+(\S+)/);
	if (!defined($w2)){
		send_notice($nick, "Erreur de syntaxe : part <chan>",$sock);
	}
	else{
		part ($w2,$sock);
		send_notice($nick,"Requête effectuée",$sock);
	}
};
sub order_bl_list{
	my ($sock,$nick,$raw) = @_;
	my $not;
	send_notice($nick, "--- BLACKLIST ---",$sock);
	send_notice($nick, " TYPE       NICKNAME",$sock);				    	
	while (my ($k,$v) = each(%blacklist)){
		send_notice ($nick, "[CHAN]       $k",$sock) if ($v == 1);
		send_notice ($nick, "[SERV]       $k",$sock) if ($v == 2);
	}
};
#--Administration MESSAGE PUBLICS
sub order_mode{
	my ($sock,$nick,$raw,$chan) = @_;
	my ($w1,$w2) = ($raw =~ /^(\S+)\s+(\S+)/);
	if (!defined($w2)){
		send_notice($nick,"Erreur de syntaxe : !m <modes> <cible>",$sock);
	}
	else{
		my ($w3) = ($raw =~ /^\S+\s+\S+\s(\S+)/);
		if (!defined($w3)){ #sans paramètre
			change_mode($w2,$chan,$sock)
		}
		else{ #avec paramètre
			change_mode($w2,$chan,$sock,$w3);
		}
	}
};
sub order_kick{
	my ($sock,$nick,$raw,$chan,$botnick) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /(\S+)\s+(\S+)\s*(.*)/);
	if ($w2 =~ /^$botnick$/i){
		send_notice($nick,"Erreur, vous ne pouvez pas expulser le robot",$sock);
		return 0;
	}
	if (!defined($w2)){
		send_notice($nick,"Erreur de syntaxe : !xk <nick> <raison>",$sock);
	}
	else{
		kick($w2,$chan,$sock,$w3);
	}
};
sub order_add_blacklist_akick{
	my ($sock,$nick,$raw,$botnick,$chan,) = @_;
	my ($w1,$w2) = ($raw =~ /(\S+)\s+(\S+)/);
	if ($w2 =~ /^$botnick$/i){
		send_notice($nick,"Erreur, vous ne pouvez pas blacklister le robot",$sock);
		return 0;
	}
	if (!defined ($w2)){
		send_notice($nick,"Erreur de syntaxe : !xbl (/msg bl) <nick> ",$sock);
	}
	else{
		send_notice($nick,"L'utilisateur $w2 a bien été ajouté à la blacklist. Tappez !xunbl <pseudo> pour l'y en retirer.",$sock);
		log_actions("$nick BLACKLISTED $w2 [KICK]");
		$w2 =~ tr/A-Z/a-z/;
		$blacklist{$w2} = 1;
		kick($w2,$chan,$sock,"-- Requested by $nick ::: Added to the BLACKLIST --");
	}
};
sub order_rem_blacklist_akick{
	my ($sock,$nick,$raw,$chan) = @_;
	my ($w1,$w2) = ($raw =~ /(\S+)\s+(\S+)/);
	if (!defined ($w2)){
		send_notice($nick,"Erreur de syntaxe : !xunbl (/msg unbl) <nick>",$sock);
	}
	else{
		$w2 =~ tr/A-Z/a-z/;
		if(defined($blacklist{$w2})){
			$blacklist{$w2} = undef;
			send_notice($nick,"Le pseudo $w2 a bien été retiré de la blacklist",$sock);
			log_actions("$nick REMOVE $w2 from blacklist");
		}
		else{
			send_notice($nick,"Impossible de trouver l'entrée",$sock);
		}
	}
};
sub order_add_blacklist_agline{
	my ($sock,$nick,$raw,$botnick,$chan) = @_;
	my ($w1,$w2) = ($raw =~ /^(\S+)\s+(\S+)/);
	if ($w2 =~ /^$botnick$/i){
		send_notice($nick,"Erreur, vous ne pouvez pas blacklister le robot",$sock);
		return 0;
	}
	if (!defined ($w2)){
		send_notice($nick,"Erreur de syntaxe : !xsbl (/msg sbl) <nick> ",$sock);
	}
	else{
		send_notice($nick,"L'utilisateur $w2 a bien été ajouté à la blacklist. Tappez !xunbl <pseudo> pour l'y en retirer.",$sock);
		print_uchan("$nick a ajouté le pseudo $w2 à la liste noire du serveur. Toute connection de ce pseudo sera automatiquement G-Lined",$sock);
		$w2 =~ tr/A-Z/a-z/;
		log_actions("$nick BLACKLISTED $w2 [G-LINE]");
		$blacklist{$w2} = 2;
	}
};

sub order_set_ident{
	my ($sock,$nick,$raw,$chan) = @_;
	my ($w1,$w2) = ($raw =~ /(\S+)\s+(\S+)/);
	if (!defined($w2)){
		send_notice($nick,"Erreur de syntaxe : !xid <identifiant>",$sock);
	}
	else{
		$w2 =~ tr/A-Z/a-z/;
		$conf{"IDENT"} = $w2;
		send_notice($nick,"L'identifiant $w2 est désormais interdit sur les salons. Tapez !xuid pour désactiver le ban à vue",$sock);
		print_uchan("$nick a interdit l'identifiant $w2. Toute connection sur le serveur comportant ce motif sera automatiquement G-LINED",$sock);
		log_actions("$nick set auto-gline on ident $w2");
	}
};
sub order_rem_ident{
	my ($sock,$nick,$raw,$chan) = @_;
	my ($w1) = ($raw =~ /(\S+)/);
	if (!defined ($conf{"IDENT"})){
		send_notice($nick,"Aucun identifiant n'est interdit actuellement.",$sock);
	}
	else{
		$conf{"IDENT"} = undef;
		print_uchan("$nick à levé l'intediction d'identifiant.",$sock);
		log_actions("$nick remove auto-gline on the ident");
		send_notice($nick,"La protection anti-idenfiant est désactivée.",$sock);
	}
};
sub order_smode{
	my ($sock,$nick,$raw) = @_;
	if(!defined($conf{"SMODE"})){
		$conf{"SMODE"} = 1;
		print_uchan("$nick a activé le mode de sécurité serveur maximum. Aucune connection entrante ne sera accéptée jusqu'à ce que vous levez l'interdiction (!xusmode)",$sock);
		send_notice($nick,"Mode de sécurité maximum activé ! Tapez !xsusmode pour le retirer",$sock);
		log_actions("$nick set SECURITY-MODE ON");
	}
	else{	
		send_notice($nick,"Le mode de sécurité maximum est déjà activé",$sock);
	}
};
sub order_rem_smode{
	my ($sock,$nick,$raw) = @_;
	if (!defined($conf{"SMODE"})){
		send_notice($nick,"Le mode de sécurité est déja desactivé !",$sock);
	}
	else{
		$conf{"SMODE"} = undef;
		send_notice($nick,"Mode de sécurité desactivé",$sock);
		log_actions("$nick set SECURITY-MODE OFF");
		print_uchan("$nick à desactivé le mode de sécurité maximum !",$sock);
	}
};
sub order_help{
	my ($sock,$nick,$chan) = @_;
	send_notice($nick,"------------------- Commandes Géofront -------------------",$sock);
	send_notice($nick,"		Commandes en Message Privé:",$sock);
	send_notice($nick,"auth <password> ................ authentification sur le robot",$sock);
	send_notice($nick,"load ........................... recharge le fichier root_axx.conf en mémoire",$sock);
	send_notice($nick,"join <#chan> ................... rejoint le salon spécifié",$sock);
	send_notice($nick,"part <#chan> ................... part du salon spécifié",$sock);
	send_notice($nick,"quit ........................... quitte le serveur",$sock);
	send_notice($nick,"unban <#chan> .................. débannit votre host du salon spécifié (ban de la forme *!*\@votrehost)",$sock);
	send_notice($nick,"oper <user> <password> ......... permet au robot de s'identifier en temps qu'IRCOP",$sock);
	send_notice($nick,"kill <pseudo>",$sock);
	send_notice($nick,"kline <pseudo> ................. permet de kill (respct. k-line / g-line / z-line) l'utilisateur spécifié du serveur.",$sock);
	send_notice($nick,"gline <pseudo>",$sock);
	send_notice($nick,"zline <pseudo>",$sock);
	send_notice($nick,"bl / unbl <pseudo> ........... permet de blacklister (respct. retirer de la blacklist) l'utilisateur spécifié.",$sock);
	send_notice($nick,"sbl / unbl <pseudo> .......... permet de blacklister (respct. retirer de la blacklist) du serveur l'utilisateur spécifié.",$sock);
	send_notice($nick,"smode / unsmode .............. bloque (respct. lève le blocage) des connections serveur.",$sock);
	send_notice($nick, "mode <target> <mode> ........ ajoute/retire le(s) modes spécifiés sur la cible.",$sock);
	send_notice($nick,"bllist ....................... affiche la blacklist.",$sock);
	send_notice($nick,"                   ",$sock);
	send_notice($nick,"			Commandes en Message Public:",$sock);
	send_notice($nick,"!m <mode> <parametre>* .......... execute le(s) mode(s) sur le salon spécifié associé au paramètre éventuellement précisé",$sock);
	send_notice($nick,"!xk <pseudo> <raison>* .......... kick le pseudo avec la raison éventuellement précisée",$sock);
	send_notice($nick,"!xkill <pseudo> <raison>*",$sock);
	send_notice($nick,"!xkline <pseudo> <raison>*",$sock);
	send_notice($nick,"!xgline <pseudo> <raison>*........ kill (respct k-line/g-line/z-line) l'utilisateur spécifié du serveur",$sock);
	send_notice($nick,"!xzline <pseudo> <raison>*",$sock);
	send_notice($nick,"!xbl <pseudo> .................... ajoute le pseudo spécifié à la blacklist (liste des AutoKick/ban)",$sock);
	send_notice($nick,"!xubl <pseudo> ................... retire le pseudo spécifié de la blacklist",$sock);
	send_notice($nick,"!xsbl <pseudo> .................... blacklist le pseudo sur le serveur (se retire avec !xubl)",$sock); 
	send_notice($nick,"!xbllist .......................... affiche la liste des utilisateurs blacklistés",$sock);
	send_notice($nick,"!xid <ident> ..................... Bloque l'identifiant <ident> (G-line toute personne rejoignant le salon dont le pseudo comporte le motif spécifié dans <ident>)",$sock);
	send_notice($nick,"!xuid ............................ retire le bloquage de l'identifiant.",$sock);
	send_notice($nick,"!xsmode / !xunsmode .............. bloque (respct. lève le blocage) des connections serveur.",$sock);
	send_notice($nick,"Nota bene : les paramètres suivis d'un asterisque * sont facultatifs",$sock);
	
};
#--Systèmes OPER
sub order_kill{
	my ($sock,$nick,$raw,$botnick) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /^(\S+)\s+(\S+)\s*(.*)/);
	if ($w2 =~ /^$botnick$/i){
		send_notice($nick,"Erreur, vous ne pouvez pas déconnecter le robot",$sock);
		return 0;
	}
	if (!defined($w2)){	
		send_notice($nick,"Erreur de syntaxe : [!xkill / msg kill] <nick> <raison>",$sock);
	}
	else{
		kill_($w2,$sock,$nick,$w3);
	}
};
sub order_gline{
	my ($sock,$nick,$raw,$botnick) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /^(\S+)\s+(\S+)\s*(.*)/);
	if ($w2 =~ /^$botnick$/i){
		send_notice($nick,"Erreur, vous ne pouvez pas déconnecter le robot",$sock);
		return 0;
	}
	if (!defined($w2)){	
		send_notice($nick,"Erreur de syntaxe : [!xgline / msg gline] <nick> <raison>",$sock);
	}
	else{
		G_line($w2,$sock,$nick,$w3);
	}
};
sub order_kline{
	my ($sock,$nick,$raw,$botnick) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /^(\S+)\s+(\S+)\s*(.*)/);
	if ($w2 =~ /^$botnick$/i){
		send_notice($nick,"Erreur, vous ne pouvez pas déconnecter le robot",$sock);
		return 0;
	}
	if (!defined($w2)){	
		send_notice($nick,"Erreur de syntaxe : [!xkline / msg kline] <nick> <raison>",$sock);
	}
	else{
		K_line($w2,$sock,$nick,$w3);
	}
};
sub order_zline{
	my ($sock,$nick,$raw,$botnick) = @_;
	my ($w1,$w2,$w3) = ($raw =~ /^(\S+)\s+(\S+)\s*(.*)/);
	if ($w2 =~ /^$botnick$/i){
		send_notice($nick,"Erreur, vous ne pouvez pas déconnecter le robot",$sock);
		return 0;
	}
	if (!defined($w2)){	
		send_notice($nick,"Erreur de syntaxe : [!xzline / msg zline] <nick> <raison>",$sock);
	}
	else{
		Z_line($w2,$sock,$nick,$w3);
	}
};
#-- Network

sub connection_serv{
	my ($name,$sock,$pass) = @_;
	print $sock "PASS $pass\r\n" if (defined($pass));
	print $sock "NICK $name\r\n";
	print $sock "USER iService localhost irc_server :18 F iZy <3\r\n"
};

#--Fonction utillitaires
sub get_type{
	my ($raw) = @_;
	my ($entete) = ($raw =~ /^:*([^:]*):/); #Si l'entête prends un paramètre
	if(!($entete =~ /\S+/)){
		$entete = $raw;
	}
	return $entete;
};
sub get_usrname{#retourne le nick/usr/host
	my ($raw) = @_;
	my ($nick,$usr,$host) = ($raw =~ /^(.*)!(.*)@(.*)/);
	return ($nick,$usr,$host);
};
sub uncolor_raw{#Supprime la couleur du texte
	my ($msg) = @_;
	chomp $msg;
	$msg =~ s/[0,1]{0,1}[0-9]{0,1}//g;
	$msg =~ s///g;
	#$msg =~ s///g;
	$msg =~ s///g;
	return $msg;
};

sub load_axx{ #charge en mémoire la liste des accès
	%admin = undef;
	open FIC,"root_axx.conf"; #Syntaxe :: user pass
	while (<FIC>){
		my ($usr,$pass) = ($_ =~ /^(\S+)\s(\S+)/);
		chomp $usr;
		chomp $pass;
		$usr =~ tr/A-Z/a-z/;
		$admin{$usr} = $pass;
	}
	close FIC;

};
sub is_register{ #regarde si le pseudo est inscrit
	my ($host) = @_;
	my $geo_h = $conf{"GEO_HOST"};
	if ($host =~ /^$geo_h/i){
		return 1;
		}
	else{
		return 0;
	}
};
sub log_actions{
	my ($data) = @_;
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	$mon++;
	$year += 1900;
	open FIC, ">>log_IRCOP.log";
	print FIC "[$mday/$mon/$year]- $hour:$min:$sec # $data\n";
	close FIC;
};

sub print_uchan{
	my ($data,$sock) = @_;
	if (defined($conf{"UCHAN"})){
		send_pubmsg($conf{"UCHAN"},$data,$sock);
	}
};
#--Event

sub on_ping{
	my ($raw,$sock) = @_;
	my ($pong) = ($raw =~ /^PING (:\w*)/);
	print $sock "PONG $pong\r\n";
};

sub on_join{
	my ($ans,$sock) = @_;
	my ($src,$canal) = ($ans =~ /^:(\S*)\sJOIN\s:(\S*)/);
	my ($nick,$usr,$host) = get_usrname($src);
	$nick =~ tr/A-Z/a-z/;
	if ($blacklist{$nick} == 1){
		change_mode("+b",$canal,$sock,"*!*\@$host");
		kick($nick,$canal,$sock,"BLACKLISTED !");
		return 0;
	}
};
sub on_part{
	my ($ans,$sock) = @_;
	my ($src,$canal) = ($ans =~/^:(\S*)\sPART\s(\S*)/); #pas de ":" => iZy_TeH_PariaH!iZoMorphisM@reagi-100E34EF.w86-219.abo.wanadoo.fr PART #ados
	my ($nick,$usr,$host) = get_usrname($src);

};
sub on_quit{
	my ($ans,$sock) = @_;
	my ($src) = ($ans =~ /^:(\S*)\sQUIT\s/);
	my ($nick,$usr,$host) = get_usrname($src);
};
sub on_privmsg{
	my ($ans,$sock,$botnick,%admin) = @_;
	my ($src,$dst,$msg) = ($ans =~ /^:(\S*)\sPRIVMSG\s(\S*)\s:(.*)/);
	my ($nick,$usr,$host) = get_usrname($src);
	my $servhost = $conf{"SERV_ADMIN_HOST"};
	if(!($dst =~ /^$botnick$/i)){
		on_pubmsg($src,$dst,$msg,$sock,$botnick);
		return 0;
	}
	on_privmsg_admin($src,$dst,$msg,$nick,$sock,$host,$botnick) if (is_register("$host"));
	on_privmsg_servadmin($src,$dst,$msg,$nick,$sock,$host,$botnick) if ($host =~ /^$servhost$/i);
	on_version($nick,$sock) if($msg =~ /^VERSION\s/);
	if($msg =~ /^AUTH\s/i){ #Authentification dans le chat.
		if (is_register("$host")){
			send_notice($nick,"Vous êtes déjà authentifié.",$sock);
		}
		else{
			my ($pass) = ($msg =~ /^\S*\s(\S*)/);
			my $sha1 = sha1_hex($pass);
			$nick =~ tr/A-Z/a-z/;
			if($admin{$nick} eq $sha1){
				change_host($nick,$conf{"GEO_HOST"},$sock);
				send_notice($nick,"Vous êtes désormais authentifié",$sock);
			}
			else{
				send_notice($nick,"Echec de l'authentification",$sock);
				kill_($nick,$sock,"Anti-Bruteforce Security System","Password missmatch");
			}
		}
	}
	
	return 0;
};
sub on_privmsg_admin{ #messages privés venant d'admins
	my ($src,$dst,$msg,$nick,$sock,$host_sender,$botnick) = @_;
	my ($word1) = ($msg =~ /^(\S+)/);
	if ($word1 eq "load"){
		load_axx();
		send_notice($nick,"Base de données des utilisateurs rechargée en mémoire.",$sock);
	}
	order_mod_axx($sock,$nick,$msg) if ($word1 eq "modify");
	order_join($sock,$nick,$msg) if ($word1 eq "join");
	order_quit($sock,$nick,$msg) if ($word1 eq "quit");
	order_self_unban($sock,$nick,$msg,"*!*\@$host_sender") if ($word1 eq "unban");
	order_part($sock,$nick,$msg) if ($word1 eq "part");
	order_bl_list($sock,$nick,$msg) if ($word1 eq "bllist");
	#oper
	order_oper($sock,$nick,$msg) if ($word1 eq "oper");	
	order_kill($sock,$nick,$msg,$botnick) if ($word1 eq "kill");
	order_gline($sock,$nick,$msg,$botnick) if ($word1 eq "gline");
	order_kline($sock,$nick,$msg,$botnick) if ($word1 eq "kline");
	order_zline($sock,$nick,$msg,$botnick) if ($word1 eq "zline");
	order_add_blacklist_agline($sock,$nick,$msg,$botnick) if ($word1 eq "sbl");
	order_add_blacklist_akick($sock,$nick,$msg,$botnick) if ($word1 eq "bl");
	order_rem_blacklist_akick($sock,$nick,$msg) if ($word1 eq "unbl");
	order_set_mode($sock,$nick,$msg) if ($word1 eq "mode");
	order_smode($sock,$nick,$msg) if ($word1 eq "smode");
	order_rem_smode($sock,$nick,$msg) if ($word1 eq "unsmode");
	#help
	order_help($sock,$nick,$msg) if ($word1 eq "help");

};
sub on_pubmsg{
	my ($src,$dst,$msg,$sock,$botnick) = @_;
	my ($nick,$usr,$host) = get_usrname($src);
	on_pubmsg_admin($nick,$src,$dst,$msg,$sock,$botnick) if(is_register("$host"));
};
sub on_pubmsg_admin{ #messages venant d'admins
	my ($nick,$src,$dst,$msg,$sock,$botnick) = @_;
	order_mode($sock,$nick,$msg,$dst) if ($msg =~ /^!m\s/i);
	order_kick($sock,$nick,$msg,$dst,$botnick) if ($msg =~ /^!xk\s/i);
	#oper
	order_kill($sock,$nick,$msg,$botnick) if ($msg =~ /^!xkill\s/i);
	order_gline($sock,$nick,$msg,$botnick) if ($msg =~ /^!xgline\s/i);
	order_kline($sock,$nick,$msg,$botnick) if ($msg =~ /^!xkline\s/i);
	order_zline($sock,$nick,$msg,$botnick) if ($msg =~ /^!xzline\s/i);
	order_add_blacklist_agline($sock,$nick,$msg,$botnick,$dst) if ($msg =~ /^!xsbl\s/i);
	order_add_blacklist_akick($sock,$nick,$msg,$botnick,$dst) if ($msg =~ /^!xbl\s/i);
	order_rem_blacklist_akick($sock,$nick,$msg) if ($msg =~ /^!xunbl\s/i);
	order_set_ident($sock,$nick,$msg) if ($msg =~ /^!xid\s/i);
	order_rem_ident($sock,$nick,$msg) if ($msg =~ /^!xuid\s/i);
	order_smode($sock,$nick,$msg) if ($msg =~ /^!xsmode\s/i);
	order_rem_smode($sock,$nick,$msg) if ($msg =~ /^!xunsmode\s/i);
	order_bl_list ($sock,$nick,$msg) if ($msg =~ /^!xbllist\s/i);
};
sub on_privmsg_servadmin{
	my ($src,$dst,$msg,$nick,$sock,$host,$botnick)= @_;
	order_add_axx($sock,$nick,$msg) if ($msg =~ /^add\s/i);
	order_rem_axx($sock,$nick,$msg) if ($msg =~ /^remove\s/i);
	if ($msg =~ /^load\s/i){
		load_axx();
		send_notice($nick,"Base de données des utilisateurs rechargée en mémoire.",$sock);
	}
};
sub on_mode{
	my ($ans,$sock) = @_;
	my ($src,$dst,$mode,$parametre) = ($ans =~ /^:(\S+)\sMODE\s(\S+)\s(\S+)\s*(.*)$/);
	my ($nick,$usr,$host) = get_usrname($src);
	chomp $parametre;
	if ($mode eq "+b" && $parametre =~ /^\*!\*@\*/){
		kick($nick,$dst,$sock,"Taking Over detected");
		change_mode("-b",$dst,$sock,"*!*@*")
	}
};
sub on_version{
	my ($nick, $sock) = @_;
	send_notice($nick,"SinuZoiD System, bot de sécurité en Perl rédigé par iZy_TeH_PariaH",$sock);
};
sub on_notice{
	my ($ans,$sock) = @_;
	my ($src,$dst,$msg) = ($ans =~ /^(\S+)\sNOTICE\s(\S+)\s:(.*)$/);
	my ($nick,$usr,$host) = get_usrname($src);
	if (!defined($usr)){ #si ça ne matche pas
		#serv notice
		on_serv_notice($src,$dst,$msg,$sock); #src contient l'adresse server
	}
	else{
		#user notice

	}
};
sub on_nick{
	my ($ans,$sock) = @_;
};
sub on_serv_notice{
	my ($src,$dst,$msg,$sock) = @_;
	my ($info,$data) = ($msg =~ /\*\*\*\s+Notice\s+--([^:]*):\s(.*)$/);
	print_uchan("$msg",$sock);
	on_new_connection($info,$data) if ($info =~ /Client\sconnecting\s/i);
	on_new_exit($info,$data) if ($info =~ /Client\sexiting/i);
};
sub on_new_connection{
	my ($info,$data) = @_;
	my ($nick,$realh) = ($data =~ /(\S+)\s\((\S+)\)/);
	$nick =~ tr/A-Z/a-z/;
	$realh =~ s/^\S+\@//;
	if(defined($conf{"SMODE"})){
		kill_($nick,$sock,"Security System","Mode de sécurité activé ! Merci de vous reconnecter ulterieurement.");
	}
	if(defined($conf{"IDENT"})){
		my $id = $conf{"IDENT"};
		G_line($nick,$sock,"-- Match with blacklisted ident --") if ($nick =~ /$id/i);
		return 0;
	}
	if ($blacklist{$nick} == 2){
		G_line($nick,$sock,"-- BLACKLISTED ! --");
		return 0;
	}
};
sub on_new_exit{
	my ($info,$data) = @_;
	my ($pseudo,$realh) = ($data =~ /(\S+)\s\((\S+)\)/);
	$realh =~ s/^\S+\@//;
	chomp $pseudo;
	chomp $realh;
};
sub on_raw_311{# nick user host
	my ($ans,$sock) = @_;
	my ($nickname,$usrname,$hostname) = ($ans =~ /^:\S+\s311\s\S+\s(\S+)\s(\S+)\s(\S+)\s*:*/);
	$nickname =~ tr/A-Z/a-z/;
};
sub on_raw_378{ #is connecting from...
	my ($ans,$sock) = @_;
	my ($targ,$host,$ip) = ($ans =~ /(\S+)\s:is\sconnecting\sfrom\s(\S+)\s(\d+\.\d+\.\d+\.\d+)\s*$/);
};
sub on_raw_318{ #end of /whois
	my ($ans,$sock) = @_;
	my ($nickname) = ($ans =~ /^:\S+\s318\s\S+\s(\S+)\s*:*/);
		
};
#--Action
sub change_nick{
	my ($nick,$sock) = @_;
	print $sock "NICK $nick\r\n";
};
sub send_notice{
	my ($dst,$msg,$sock) = @_;
	print $sock "NOTICE $dst :$msg\r\n";
};
sub send_msg{
	my ($dst,$msg,$sock) = @_;
	print $sock "PRIVMSG $dst :$msg\r\n";
};
sub join_c{
	my ($chan,$sock) = @_;
	print $sock "JOIN $chan\r\n";
};
sub kill{
	my ($nick,$sock,$arg) = @_;
	if (!($arg)){
		print $sock "KILL $nick :-- Requested by an IRCOP --\r\n";
	}
	else{
		print $sock "KILL $nick :$arg\r\n";
	}
};
sub change_mode{
	my ($mode,$targ,$sock,$para) = @_;
	print $sock "MODE $targ $mode\r\n" if (!defined($para));
	print $sock "MODE $targ $mode $para\r\n" if (defined($para));
};
sub kick{
	my ($targ,$chan,$sock,$raison) = @_;
	print $sock "KICK $chan $targ :--Requested--\r\n" if (!($raison));
	print $sock "KICK $chan $targ :$raison\r\n" if (defined($raison));
};
sub whois{
	my ($targ,$sock) = @_;
	print $sock "WHOIS $targ\r\n";
};
sub send_pubmsg{
	my ($targ,$data,$sock) = @_;
	print $sock "PRIVMSG $targ :$data\r\n";
};
sub part{
	my ($targ,$sock) = @_;
	print $sock "PART $targ :-- Requested by a Geofront --\r\n";
};
#oper
sub change_host{
	my ($targ,$new_host,$sock) = @_;
	print $sock "CHGHOST $targ $new_host\r\n";
};
sub kill_{
	my ($targ,$sock,$nick,$raison) = @_;
	print $sock "KILL $targ :$raison\r\n" if ($raison);
	print $sock "KILL $targ :--Requested--\r\n" if (!$raison);
	log_actions("$nick killed $targ [Raison : $raison]");
}
sub G_line{
	my ($targ,$sock,$raison) = @_;
	print $sock "GLINE $targ :$raison\r\n" if (defined($raison));
	print $sock "GLINE $targ :G-lined [Requested by an IRCOP/Geofront]\r\n" if (!defined ($raison));
	log_actions("$nick G-LINED $targ [Raison : $raison]");
};
sub K_line{
	my ($targ,$sock,$raison) = @_;
	print $sock "KLINE $targ :$raison\r\n" if (defined($raison));
	print $sock "KLINE $targ :K-lined [Requested by an IRCOP/Geofront]\r\n" if (!defined($raison));
	log_actions("$nick K-LINED $targ [Raison : $raison]");
};
sub Z_line{
	my ($targ,$sock,$raison) = @_;
	print $sock "ZLINE $targ :$raison\r\n" if (defined($raison));
	print $sock "ZLINE $targ :Z-lined [Requested by an IRCOP/Geofront]\r\n" if (!defined($raison));
	log_actions("$nick Z-LINED $targ [Raison : $raison]");
};
#EOF

Conclusion :


J'espère que vous tirerez un apprentissage de cette source ! J'ai essayé de commenter le code pour que la comprehension ne soit pas trop rude ! Merci de me reporter les bugs si vous en trouvez !

Enjoy !

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.