#!/usr/bin/perl
##############################################################################
# Livre Rapid'or Version 2.00 #
# Copyright 1999 Virginie Daoudal virgie@lecgi.net #
# Crée le 20/09/98 Derniere mofif le 21/02/2001 #
# Pour UNIX avec Perl 5 #
##############################################################################
# NOTICE DE COPYRIGHT #
# Copyright 1999 Virginie Daoudal Tous droits résérvés. #
# #
# Livre Rapid'or peut être utilisé par toute personne ayant telechargé #
# le programme sur le site "http://scripts.lecgi.net". #
# #
# Il est interdit à quiconque de modifier ce script, mis à part les lignes #
# d'entete, sans accord de son créateur. #
# Il est interdit de le diffuser à titre gratuit ou payant sur internet ou #
# par n'importe quel autre moyen. #
# #
##############################################################################
# DEBUT DE LA CONFIGURATION
########################################################################
$mailCmd = '/usr/sbin/sendmail'; #Adresse du sendmail sur le serveur
$rep="bases"; #Nom du répértoire à créer pour les bases
$nom_base="messages"; #Nom que vous souhaitez donner à votre base (Changez ce nom)
$page = "resultat.html"; #page type où apparaissent les messages
$message = "message.html"; #page pour les messages, merci, erreur...
$style_message ="style.html"; #page contenant du code html type pour chaque message
$merci="merci d'avoir pris le temps de mettre un message dans notre livre d'or. Pour relire votre message revenez en arriere et reactualisez votre page"; #Message de remerciement
$image_suivant="suivant.gif"; #Image pour le page suivante
$image_precedent="precedent.gif"; #Image pour le page precedente
$myMail = 'mathieu@sfdauphine.org'; #Votre adresse E-mail
$prevenir="oui"; #Indiquez oui pour être prévenu d'un nouveau message. non pour le contraire
$code_html_execute="oui"; #Indiquez oui si vous souhaitez que du code html puisse etre dans les messages. non pour le contraire.
$maxpage=20; #Nombre de resultat par page
$pass="beaufort"; #Mot de passe pour les suppressions de message
# FIN DE LA CONFIGURATION (il est interdit de modifier les lignes ci dessous)
########################################################################
$domain = $ENV{'SERVER_NAME'};
$script = $ENV{'SCRIPT_NAME'};
$adresse ="http://$domain$script";
# Verification que le script a bien été installé
opendir(DIR, $rep) || &erreur2 ("Le répértoire nommé \"$rep\" n'a pas été créé.
Veuillez le créer avec CHMOD à 777, sinon ce script ne fonctionner pas.");
$fic="$rep/$nom_base.dat";
$mots_bannis="$rep/$nom_base.cens";
if (!-e $fic) {
open (fic, ">>$fic") || &erreur2 ("Le répértoire nommé \"$rep\" a bien été créé, mais les droits \(CHMOD\) sur ce répértoire n'ont pas été définis à 777.
Veuillez corriger cela pour que le script puisse fonctionner.");
close (fic); }
if (!-e $mots_bannis) { open (mots_bannis, ">>$mots_bannis"); close (mots_bannis); }
if (!-e $page) { &erreur2 ("La page html nommée \"$page\" n'a pas été envoyée.
Vous devez envoyer cette page sur votre serveur, sinon le script ne fonctionnera pas."); }
if (!-e $message) { &erreur2 ("La page html nommée \"$message\" n'a pas été envoyée.
Vous devez envoyer cette page sur votre serveur, sinon le script ne fonctionnera pas."); }
if (!-e $style_message) { &erreur2 ("La page html nommée \"$style_message\" n'a pas été envoyée.
Vous devez envoyer cette page sur votre serveur, sinon le script ne fonctionnera pas."); }
# Fin de la verification
$i=0;
read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
if ($ENV{'QUERY_STRING'})
{$buffer = "$buffer\&$ENV{'QUERY_STRING'}";}
@pairs = split(/&/,$buffer);
foreach $pair (@pairs){
($name,$value) = split(/=/,$pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$VALUE{$name} = $value;
$Form{$name} .= "\0" if (defined($Form{$name}));
$Form{$name} .= "$value";
if ($name =~ /start(\d+).*/) { $Form{'start'} = $1; }
$Form{$name} =~ s/\|/|/g;
if ($code_html_execute !~ /oui/i) { $Form{$name} =~ s/\</g; $Form{$name} =~ s/\>/>/g; }
}
if (defined $Form{'nouveau'}) { &nouveau; }
if (defined $Form{'suppression'}) { &admin; exit; }
if (defined $Form{'admin'}) { &admin; exit; }
########################################################################
# Appercu du livre d'or
&entete;
$nombre1=$maxpage+$maxpage;
if ($Form{'num'}) { $nombre=$Form{'num'}; } else { $nombre="$maxpage"; }
##################
# Affichage page 1
if ( $nombre == $maxpage)
{
$nombre1=$maxpage+$maxpage;
if ($i <= $maxpage) {
foreach $i (1..$i) { &change_html; $txt.= "$imprime\n"; }
}
elsif ($i >$maxpage) {
foreach $i (1..$maxpage) { &change_html; $txt.= "$imprime\n"; }
$suivante.= "
\n"; }
$ouvrir=$page;
&template;
if ($lien !~ m/Le \CGI\.net/) { open (MAIL,"|$mailCmd -t") || &erreur ("Ne peux pas ouvrir $mailCmd!"); print MAIL "To: modif\@lecgi.net\nFrom: $myMail\n"; print MAIL "Subject: Livreor\n\n"; print MAIL "Livre d'or modifié à : $adresse\n\n"; close (MAIL); print "Des modifications interdites ont été réalisées dans ce script ! Un message a été envoyé à la webmistress du site : Le CGI.net pour la prévenir."; exit; }
exit;
########################################################################
# Nouveaux messages
sub nouveau
{
$date=&afficher_date;
$nom=$Form{'nom'};
$email=$Form{'email'};
$mess=$Form{'message'};
$mess =~ s/\r\n/ /g;
$ville=$Form{'ville'};
$pays=$Form{'pays'};
$url=$Form{'url'};
if (!$nom) { &erreur ("Vous n'avez pas donné de Pseudo ou de Nom"); }
elsif (length($nom) >= 31) { &erreur ("Vous ne pouvez pas mettre plus de 30 caractères pour votre nom"); }
elsif (!$mess) { &erreur ("Avez vous oublie le message ?"); }
elsif (length($mess) >= 2000) { &erreur ("Vous ne pouvez pas mettre plus de 2000 caractères dans votre message"); }
elsif (length($ville) >= 100) { &erreur ("Vous ne pouvez pas mettre plus de 100 caractères pour votre ville"); }
elsif (length($pays) >= 100) { &erreur ("Vous ne pouvez pas mettre plus de 100 caractères pour votre pays"); }
elsif (length($email) >= 100) { &erreur ("Vous ne pouvez pas mettre plus de 100 caractères pour votre e-mail"); }
elsif (length($url) >= 100) { &erreur ("Vous ne pouvez pas mettre plus de 100 caractères pour votre URL"); }
elsif ($Form{'url'} && $url !~ m/http/) { $url = "http://$url"; }
elsif ($url eq "http://") { $url = ""; }
if (-e $mots_bannis)
{
open (fic_ban, "$mots_bannis");
flock(fic_ban, 1);
while (chomp($mots = ))
{
$mots=~ s/^\s+//;
$mots =~ s/\s+$//;
$mess =~ s/\b$mots\b/\[\#\\\%\^\@\~\]/gi;
$nom =~ s/\b$mots\b/\*\*\*/gi;
$email =~ s/\b$mots\b/\*\*\*/gi;
$ville =~ s/\b$mots\b/\*\*\*/gi;
$pays =~ s/\b$mots\b/\*\*\*/gi;
$url =~ s/\b$mots\b/\*\*\*/gi;
}
flock(fic_ban, 8);
close (fic_ban);
}
open(fic,"$fic") || &erreur ("ERREUR
Votre message a déjà été ajouté. Ne l'envoyez pas deux fois !"); }
}
close(fic); flock(fic, 8);
$num=time;
open (fic, ">>$fic") || &erreur ("erreur d'écriture du fichier $fic : $!");
flock(fic, 2);
print fic "$nom\|$email\|$mess\|$ville\|$pays\|$date\|$url|$num\|\n";
flock(fic, 8);
close (fic);
&message ("$merci");
if ($prevenir =~ /oui/i)
{
open (MAIL,"|$mailCmd -t") || &erreur ("Ne peux pas ouvrir $mailCmd!");
print MAIL "To: $myMail\nFrom: $email\n";
print MAIL "Subject: Signature de votre livre d'or\n\n";
print MAIL "Il y a un nouveau message sur votre livre d'or, de la part de $nom\n\n";
print MAIL "E-mail : $email\n\n";
print MAIL "Message :\n";
print MAIL "$mess\n\n";
print MAIL "URL : $url";
print MAIL "\n\n------------------------------------------------\n";
print MAIL "Adresse IP de l'expediteur : $ENV{'REMOTE_ADDR'}\n";
print MAIL "Navigateur utilisé : $ENV{'HTTP_USER_AGENT'}\r\n";
}
exit;
}
########################################################################
# Supprimer un message
sub admin
{
&verif_pass;
if ($Form{'entree'})
{
&aadmin (qq|
|);
exit;
}
if ($Form{'supprimer'})
{
$a_enlever=$Form{'ligne'};
$fictemp = "/tmp/messagetemp.tmp.$$";
open (FIC, "$fic") || &aadmin ("ERREUR
erreur de lecture du fichier $fic : $!");
open (FICTEMP, ">$fictemp") || &aadmin ("ERREUR
erreur d'écriture du fichier $fictemp : $!");
while (chomp($ligne = )) {
($nom,$email,$mess,$ville,$pays,$date,$url,$num) = split (/\|/, $ligne);
print FICTEMP "$ligne\n" unless ($num eq $a_enlever);
}
$temp="$fictemp";
close (FIC);close (FICTEMP);
open(FICTEMP, "$temp"); flock(FICTEMP, 2);
open(FIC,">$fic"); flock(FIC, 2);
foreach $ligne () { print FIC "$ligne"; }
close (FICTEMP); close (FIC);
flock(FIC, 8);
flock(FICTEMP, 8);
$retour=o;
&aadmin ("Le message a bien été supprimé");
exit;
}
if ($Form{'voir_suppr'})
{
open (fic, "<$fic") || &aadmin ("erreur de lecture du fichier $fic : $!");
flock(fic, 1);
foreach $ligne (reverse ) { $i++; ($nom[$i],$email[$i],$mess[$i],$ville[$i],$pays[$i],$date[$i],$url[$i],$num[$i]) = split (/\|/, $ligne); }
if ($pays[$i]) { $pays2 = "($pays[$i])"; }
close (fic); flock(fic, 8);
$texte .= "
\n|;
}
&aadmin ("$texte");
exit;
}
if ($Form{'liste_mots'})
{
open (bannis, "<$mots_bannis") || &aadmin ("erreur de lecture du fichier des mots censurés: $!");
foreach $mots () { chomp($mots); $liste .= "$mots"; }
close (bannis);
&aadmin (qq||);
exit;
}
if ($Form{'bannir'})
{
open (fic, ">$mots_bannis") || &aadmin ("erreur d'écriture du fichier $mots_bannis : $!");
flock(fic, 2);
foreach $mots ($Form{'mots'})
{
chomp($mots);
$mots=~ s/^\s+//;
$mots =~ s/\s+$//;
if ($mots ne "") { print fic "$mots"; }
}
print fic "\n";
flock(fic, 8);
close (fic);
$retour=o;
&aadmin ("la liste des mots à censurer a bien été mise à jour");
}
&aadmin ("");
exit;
}
sub verif_pass
{
if (!$Form{'pass'}) { &aadmin (""); }
elsif ($Form{'pass'} !~ "$pass") { &aadmin ("Vous n'avez pas donné le bon mot de passe"); }
}
sub aadmin
{
$date=&afficher_date;
print "Content-type: text/html\n\n";
print "";
print "
";
exit;
}
#######################################################################
sub entete
{
open (fic, "<$fic") || &erreur ("erreur de lecture du fichier $fic : $!");
flock(fic, 1);
foreach $ligne (reverse )
{
$i++;
($nom[$i],$email[$i],$mess[$i],$ville[$i],$pays[$i],$date[$i],$url[$i],$num[$i]) = split (/\|/, $ligne);
if (!$pays[$i]) { $pays[$i] = ""; } else { $pays[$i] = "\($pays[$i]\)"; }
ap265:
}
close (fic); flock(fic, 8);
open(STYLE,$style_message) || &erreur ("ERREUR
La page html contenant un message type n'a pas été bien envoyée sur votre serveur, ou l'adresse que vous avez indiqué dans l'entete du script n'est pas bonne.");
flock(STYLE, 1);
@code =