#!/usr/bin/perl

use strict;
use vars qw(%form %CONF $VERSION $DATA_DIR $FONT);
print "Content-type: text/html\n\n" unless ($ENV{'QUERY_STRING'}=~ /^referer\=/);  # On affiche l'en-tête HTML indispensable

##### CONFIG ###################################
$VERSION='4.0';   # 30/04/2003
$DATA_DIR='pg-agentsecret-data';
################################################
##############################################################################
# Ceci est un script CGI en Perl, réalisé par Sébastien Joncheray.           #
# Vous pouvez l'utiliser gratuitement, à la condition expresse et            #
# non négociable de ne pas le modifier du tout, ni de le réutiliser/recopier #
# en tout ou partie, revendre, louer, redistribuer, etc.                     #
# Un droit d'utilisation gratuite vous est accordé. Tous les autres droits   #
# sont réservés. Toute contrefacon fait l'objet de poursuites. Nous vous     #
# fournissons gratuitement ce script de qualité,merci de respecter le travail#
# de l'auteur. Pour nous contacter si besoin, voyez sur www.perl-gratuit.com #
##############################################################################
# IL EST PAR-DESSUS TOUT INTERDIT DE MODIFIER LES MENTIONS DE L'AUTEUR       #
# (COPYRIGHT, SITE DE L'AUTEUR,ETC). CELA EST LA CONTREPARTIE DE LA GRATUITé #
##############################################################################
# De nombreux autres scripts perl en francais, sont disponibles gratuitement #
# sur notre site : http://www.perl-gratuit.com                               #
#                                                                            #
# En cas de difficultés d'installations veuillez consultez les FAQs et autres#
# sections d'aide sur www.perl-gratuit.com, avant d'envoyer un E-Mail SVP... #
##############################################################################
# Tous droits de modification/distribution/vente strictement réservés        #
##############################################################################
%form=&receive_getpost;
&init;



  #### ENVOI DE L'E-MAIL D'ABORD ####
  my %tmpl=();                                  # on va stocker les informations dedans
  # date + heure
  $tmpl{'date'}=&getdate;
  # IP:
  $tmpl{'ip'}=$ENV{'REMOTE_ADDR'};
  # nom d'hote du visiteur :
  if (($ENV{'REMOTE_HOST'} ne '') && ($ENV{'REMOTE_HOST'} ne $ENV{'REMOTE_ADDR'})) {
    $tmpl{'remote_host'}=$ENV{'REMOTE_HOST'};
  } else {
    $tmpl{'remote_host'}=&convert_ip($ENV{'REMOTE_ADDR'}) || 'Non Résolu';
  }
  # page visitée
  if ($ENV{'HTTP_REFERER'} ne '') {
    $tmpl{'http_referer'}="<a href=\"".&formfield_encode($ENV{'HTTP_REFERER'})."\">".&formfield_encode($ENV{'HTTP_REFERER'})."</a>";
  } else {
    $tmpl{'http_referer'}='?';
  }
  # page référante
  if ($form{'referer'} ne '') {
    $tmpl{'http_referer_referer'}="<a href=\"".&formfield_encode($form{'referer'})."\">".&formfield_encode($form{'referer'})."</a>";
  } else {
    $tmpl{'http_referer_referer'}='?';
  }
  # Navigateur
  $tmpl{'browser'}=$ENV{'HTTP_USER_AGENT'};
  if ($ENV{'HTTP_USER_AGENT'}=~ /MSIE/i)       { $tmpl{'browser'}.="(Microsoft Internet Explorer)"; }
  elsif ($ENV{'HTTP_USER_AGENT'}=~ /Mozilla/i) { $tmpl{'browser'}.="(Netscape)"; }
  # cookies:
  if (exists($form{'cookie_ok'})) {
    $tmpl{'cookie_ok'}=$form{'cookie_ok'}?'Oui':'Non';
  } else {
    $tmpl{'cookie_ok'}='?';
  }
  # résolution:
  if (exists($form{'scr_w'})) {
    $tmpl{'scr_w'}=int($form{'scr_w'});
    $tmpl{'scr_h'}=int($form{'scr_h'});
  } else {
    $tmpl{'scr_w'}=$tmpl{'scr_h'}='?';
  }
  # couleurs
  if (exists($form{'scr_c'})) {
    $form{'scr_c'}=int($form{'scr_c'});
    if ($form{'scr_c'} == 8) {
      $tmpl{'scr_c'}="256 couleurs (8 bits)";
    } elsif ($form{'scr_c'} == 16) {
      $tmpl{'scr_c'}="65 000 couleurs (16 bits)";
    } elsif ($form{'scr_c'} == 24) {
      $tmpl{'scr_c'}="True Color (24 bits)";
    } elsif ($form{'scr_c'} == 32) {
      $tmpl{'scr_c'}="True Color (32 bits)";
    } else {
      $tmpl{'scr_c'}="$form{scr_c} bits";
    }
  } else {
    $tmpl{'scr_c'}='?';
  }
  foreach ('date','ip','remote_host','browser','cookie_ok','scr_w','scr_h','scr_c') {
    $tmpl{$_}=&formfield_encode($tmpl{$_});
  }
  
  my $message=qq|<html><body>
  <p>$FONT<b>Bonjour webmaster !</b><br>
  &nbsp;<br>
  PG-AgentSecret vous signale une visite sur votre site :</font></p>
  <table cellspacing="0" cellpadding="1">
  <tr><td nowrap>$FONT<b>Date-heure : </b></td>             <td>$FONT$tmpl{'date'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Page visitée : </b></td>           <td>$FONT$tmpl{'http_referer'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Page référante : </b></td>         <td>$FONT$tmpl{'http_referer_referer'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Adresse IP du visiteur : &nbsp; &nbsp; </b></td> <td>$FONT$tmpl{'ip'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Nom d'hôte du visiteur : </b></td> <td>$FONT$tmpl{'remote_host'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Navigateur utilisé : </b></td> <td>$FONT$tmpl{'browser'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Cookies acceptés :</b></td> <td>$FONT$tmpl{'cookie_ok'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Résolution d'écran : </b></td>     <td>$FONT$tmpl{'scr_w'} x $tmpl{'scr_h'}</font></td></tr>
  <tr><td nowrap>$FONT<b>Couleurs écran : </b></td>         <td>$FONT$tmpl{'scr_c'}</font></td></tr>
  </table>
  <p>$FONT Signé : <i><u>votre Agent Secret</u></i></font></p>
  <table border="0" cellspacing="1" width="100%">
  <tr><td width="100%" bgcolor="#DDDDDD" align="center"><font face="Arial" size="1"><b>PG-AgentSecret. Disponible sur <a href="http://www.perl-gratuit.com">http://www.perl-gratuit.com</a></b></font></td></tr></table>
  </body></html>|;

  ## On envoi l'E-Mail !
  &send_email($CONF{'EMAIL_WEBMASTER'},$CONF{'EMAIL_WEBMASTER'},'[Votre Agent Secret]',$message);


  ## On envoie l'image (Format XBM) :
  print "Content-Type: image/x-xbitmap\n\n";
  print ("\#define count_width 8\n#define count_height 1\n"); # Déclaration taille de l'image : 8 x 1 pixels
  if ($CONF{'PIXEL_ISWHITE'}) {                          # Affichage image XBM(pixel blanc ou noir):
   print ("static char count_bits[] = {\n0x00\n};\n");   # ecriture du début du tableau contenant les valeurs des pixels
  } else {
   print ("static char count_bits[] = {\n0xff\n};\n");   # ecriture du début du tableau contenant les valeurs des pixels
  }
  #print ( join "<br>\n", map {"$_:$form{$_}"} sort keys %form  );
  
  1;
################### FIN ! ######################
################################################































################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub receive_getpost {
# 2002-09-20
my (%postdata,$data,$pair);

  $data='';
  if ($ENV{'REQUEST_METHOD'} eq 'POST') {
    my $len=$ENV{'CONTENT_LENGTH'};
    if (read(STDIN,$data,$len) != $len) {print ("<H1>error reading post data </H1>"); die("Error reading 'POST' data\n"); }
  } elsif ($ENV{'REQUEST_METHOD'} eq 'GET') {
    $data=$ENV{'QUERY_STRING'};
  }

  foreach $pair (split('&',$data)) {
    my ($name,$value)=split('=',$pair);
    $name=~ tr/\0//d;  $value=~ tr/\0//d;
    $name =~ tr/+/ /; $name =~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge;
    $value=~ tr/+/ /; $value=~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge;
    $postdata{$name}=$value;
  }
  return %postdata;
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub formfield_encode {
# 27/01/2002
my ($s)=@_;
  $s=~ s/&/&amp;/gso;
  $s=~ s/</&lt;/gso;
  $s=~ s/>/&gt;/gso;
  $s=~ s/"/&quot;/gso;
  $s;
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub verify_email {
# 29-06-2002
my ($email)=@_;

  if ($email eq '') { return(0);}
  if ( ($email =~ /(\s)|(@.*@)|(\.\.)|(@\.)|(^\.)/) || 
      (($email !~ /^[a-zA-Z0-9\-\_\.]+\@localhost$/) && 
       ($email !~ /^[a-zA-Z0-9\-\_\.]+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z0-9]+)(\]?)$/)) ) {
    return(0);
  } else {
    return(1);
  }
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub send_email {                                # Sous-programme pour envoyer un E-Mail
  my ($from,$to,$subject,$message)=@_;          # Récupération des paramètres du mail à envoyer
  $from=~ s/\s/ /gs;    # anti-spam
  $to=~ s/\s/ /gs;      # anti-spam
  $subject=~ s/\s/ /gs; # anti-spam
  if ($^O=~ /mswin/i) { print "<hr><PRE>$message</PRE><b>Ce script n'est pas fait pour fonctionner sur serveur windows! mail non envoyé!</b><hr>" and return;}
  open (MAIL, "|$CONF{'MAILPROG'} -t -oi -oem");# Appel du programme sendmail (PIPE)
  print MAIL ("Content-Type: text/html\n");
  print MAIL ("MIME-Version: 1.0\n");
  print MAIL ("To: $to\n");
  print MAIL ("From: $from\n");
  print MAIL ("Subject: $subject\n\n");
  print MAIL ("$message");
  close (MAIL);                                 # On referme le canal de communication avec sendmail, et le mail part...
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub getdate {
  my (@days)=('Dimanche','Lundi','Mardi','Mercredi','Jeudi','Vendredi','Samedi');
  # On récupère l'heure locale du serveur+décalage horaire
  my ($sec,$min,$hour,$numday,$month,$year,$weekday,$yearday,$isdst) =(localtime(time()+3600*$CONF{'TIME_OFFSET'}));
  #     0    1     2      3       4      5       6     7        8
  $month++;					# Les mois sont renvoyés de 0 à 11
  $year+=1900;					# L'années est donnée par rapport à 1900, et on veut pas de bogue de l'an 2000 !
  return (sprintf ("%s %02d / %02d / %d - %02d h %02d mn %02d s",$days[$weekday],$numday,$month,$year,$hour,$min,$sec));
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub convert_ip {
my ($ip)=@_;
my (@bytes,$name,$packaddr);                     # Déclaration des variables utilisées

  $ip =~ s/^\s+|\s+$//g;                        # on supprime des espaces éventuels en début et fin de l'IP
  @bytes = split (/\./, $ip);                   # on range dans un tableau, les 4 nombres séparés par des points de l'IP
  $packaddr = pack ("C4", @bytes);              # on encode l'adresse IP, en un entier compacté

  ($name,undef) =gethostbyaddr ($packaddr, 2);  # Résolution de l'IP. seul le nom d'hote nous intéresse, on ignore le reste
  return $name;
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################










































################################################
#######                                  #######
#######          ADMINISTRATION          #######
#######                                  #######
################################################
sub init {

  %CONF=();
  $CONF{'CGI_NAME'}='PG-AgentSecret';                               # Nom du CGI: NE PAS CHANGER SINON ERREURS...(noms images)
  $CONF{'CGI_DESC'}="Notification de visite par E-Mail";            # Description du CGI: NE PAS CHANGER SINON ERREURS...
  $CONF{'IMGCGI_URL'}='http://img-scripts.perl-gratuit.com';
  $CONF{'SERVER_NAME'}=($ENV{'SERVER_NAME'} || $ENV{'HTTP_HOST'});
  $CONF{'CGI_URL'}=($ENV{'REQUEST_URI'} || $ENV{'SCRIPT_NAME'});
  $CONF{'CGI_URL'}=~ s/\?.*//gs;                
  $CONF{'CGI0_URL'}="http://".$CONF{'SERVER_NAME'}.$CONF{'CGI_URL'}; # URL complète, à utiliser pour visiteurs only (valeur par défaut)
  
  $FONT="<font face=\"Arial\" size=\"2\">";


  ## Vérif que le répertoire des données existe ##
  if (! -e "$DATA_DIR") {
    &msg_fin("ERREUR !","Pour faire fonctionner ce CGI, il vous faut créer, dans le répertoire où se trouve
                ce script, le sous-répertoire <b>$DATA_DIR</b><br>
                N'oubliez pas de lui attribuer CHMOD 777 (tous droits de lecture,écriture,éxécution)
                si votre serveur est de type Unix.<br>
		Pour plus d'informations sur 'CHMOD', voyez sur notre site dans les fiches pratiques/FAQ.");
  }

  ## Vérif que le fichier de configuration existe ##
  if (! -e "$DATA_DIR/config.dat") {
    open(TESTW,">$DATA_DIR/config.dat") || (&msg_fin("ERREUR !","Impossible de créer le fichier <b>$DATA_DIR/config.dat</b> : $!<br> Vérifiez le CHMOD 777 du répertoire <b>$DATA_DIR</b>"));
    close(TESTW);
    eval{ chmod(0777,"$DATA_DIR/config.dat");};
    &msg_fin("Auto-installation",qq|
            <p align="center"><font face="Arial" size="3" color="#800000"><b>Bienvenue dans l'auto-installation de &quot;$CONF{'CGI_NAME'}&quot; !</b></font></p>
            <blockquote><p align="justify">$FONT Vous éxécutez ce script CGI Perl pour la première fois.
             Afin de faciliter la mise en place de ce script sur votre site, l'installation-configuration
             est guidée et automatisée par étapes successives. Un fichier de configuration va être créé,
             un choix de mot de passe administrateur vous sera demandé, puis une page de choix de configuration
             vous sera présentée. Nous vous conseillons fortement ensuite de consulter la section de documentation
             inclue.<br>&nbsp;<br>
             Toute cette procédure vous permet une mise en place aisée, sans besoin d'intervenir manuellement
             dans les fichiers et répertoires de données de ce script.</font></p></blockquote>
            <p align="center">$FONT<i>Veuillez maintenant actualiser cette page pour continuer SVP...<br>
              (cliquez sur le bouton &quot;Actualiser&quot; de votre navigateur)</i></font></p>|);
  }
  ## Vérif que le fichier mot de passe existe ##
  if (! -e "$DATA_DIR/passwd.dat") {
    open(TESTW,">$DATA_DIR/passwd.dat") || (&msg_fin("ERREUR !","Impossible de créer le fichier <b>$DATA_DIR/passwd.dat</b> : $!<br> Vérifiez le CHMOD 777 du répertoire <b>$DATA_DIR</b>"));
    close(TESTW);
    eval{ chmod(0777,"$DATA_DIR/passwd.dat");};
    &msg_fin("Auto-installation",qq|
            <p align="center"><font face="Arial" size="3" color="#800000"><b>Conditions d'utilisation gratuite :</b></font></p>
            <blockquote><p align="justify">$FONT Au bas des pages générées par ce script vous verrez un copyright
             et la mention de l'auteur (nom et lien vers notre site).<br>
             Un droit d'utilisation gratuite de ce script CGI Perl vous est accordé à la condition expresse
             de ne pas le modifier du tout (y compris et tout particulièrement ces copyrights et mentions de
             l'auteur), ni de le réutiliser/recopier en tout ou partie, revendre, louer, redistribuer, etc.
             Tous les droits autres que l'utilisation gratuite sont réservés (nous contacter au besoin).<br>&nbsp;<br>
             Tout simplement, merci de respecter le travail de l'auteur afin que nous puissions continuer
             à vous proposer de tels scripts.</font></p></blockquote>
            <p align="center">$FONT<i>Veuillez maintenant actualiser cette page pour continuer SVP...<br>
              (cliquez sur le bouton &quot;Actualiser&quot; de votre navigateur)</i></font></p>|);
    
  }
  ## Vérif que le répertoire des données est protégé ##
  if (!-e "$DATA_DIR/.htaccess") {
    open(HTW,">$DATA_DIR/.htaccess") || (&msg_fin("ERREUR !","Impossible de créer le fichier <b>$DATA_DIR/.htaccess</b> : $!<br> Vérifiez le CHMOD 777 du répertoire <b>$DATA_DIR</b>"));
    print HTW "<Limit GET POST>\norder deny,allow\ndeny from all\n</Limit>\n";
    close(HTW);
    eval{ chmod(0666,"$DATA_DIR/.htaccess");};
    &msg_fin("AUTO-PROTECTION DES DONNEES",qq|
            <p align="center"><font face="Arial" size="3" color="#800000"><b>Sécurité de votre répertoire des données</b></font></p>
            <blockquote><p align="justify">$FONT Certains serveurs peu ou mal sécurisés permettent l'accès,
             le listing et la consultation des fichiers à l'intérieur de la section &quot;cgi-bin&quot; des sites
             hébergés.<br>&nbsp;<br>
             Afin d'empêcher tout accès par la navigateur dans votre répertoire des données <b>$DATA_DIR</b>
             un fichier spécial &quot;.htaccess&quot; vient d'être automatiquement créé avec les
             directives-serveurs adéquates.<br>&nbsp;<br>
             Selon votre serveur, il se peut que vous ne puissiez pas voir le .htaccess par FTP. Dans ce cas,
             consultez la page d'informations correspondante dans la section
             <a href="http://www.perl-gratuit.com/fiches/" target="_blank"><b>Fiches Pratiques</b></a> de
             notre site.</font></p></blockquote>
            <p align="center">$FONT<i>Veuillez maintenant actualiser cette page pour continuer SVP...<br>
              (cliquez sur le bouton &quot;Actualiser&quot; de votre navigateur)</i></font></p>|);
  }
  ## Chargement configuration
  open (CONFR,"$DATA_DIR/config.dat") || &msg_fin("ERREUR !", "Impossible de lire le fichier <b>$DATA_DIR/config.dat</b>: $!");
  eval{flock(CONFR,2);};
  while (<CONFR>) {
    chomp($_);
    if ( ($_ ne '') && ($_!~ /^#/) && ($_=~ /^([^\s]+)\s+(.*)/) ) {
      $CONF{"$1"}="$2";
      $CONF{"$1"}=~ s/\|\\n\|/\n/gs;
    }
  }
  close (CONFR);
  ## Chargement mot de passe:
  open (PASSR,"$DATA_DIR/passwd.dat") || (&msg_fin("ERREUR !","Impossible de lire le fichier <b>$DATA_DIR/passwd.dat</b>: $!"));
  $CONF{'CPASSWD'}=<PASSR>;
  close(PASSR);
  chomp($CONF{'CPASSWD'});
  ## Vérif mot de passe fixé
  if ($CONF{'CPASSWD'} eq '') {  (($form{'ORDadmin_changepass_do'} eq '') && (&admin_changepass) ) || (&admin_changepass_do); }
  ## OPTIONNAL STUFF :
  $CONF{'theform'}=qq|<!-- debut code pg-agentsecret -->
<script language="JavaScript">
<!--
document.write('<img src="$CONF{CGI0_URL}?referer='+escape(document.referrer));
if(typeof(screen)=="object"){ document.write('&scr_w='+screen.width+'&scr_h='+screen.height+'&scr_c='+screen.colorDepth);}
document.write('&cookie_ok='+ (navigator.cookieEnabled?'1':'0') );
document.write('" width="1" height="1">');
// -->
</script>
<!-- fin code pg-agentsecret -->|;
  
  
  ## L'administrateur veut entrer ? ##
  if($ENV{'QUERY_STRING'} eq 'admin') { 
    &msg_fin("ENTREE ADMINISTRATEUR",qq|<center><form action="$CONF{CGI_URL}" METHOD="POST">
                                     Mot de Passe : <input type="PASSWORD" name="PASSWD"><br>&nbsp;<br>
                                     <input type="submit" value="Entrée"></form></center>|);
  }
  ## L'administrateur est déjà entré ##
  if ($form{'PASSWD'}) {                        # On vérifie le mot de passe s'il y en a un
    if (crypt($form{'PASSWD'},'aa') ne $CONF{'CPASSWD'}) {
      sleep(3);
      &msg_fin ("ACCES ADMINSTRATEUR REFUSE","<b>Le mot de passe n'est pas correct !</b><br>
                Retournez à la page précédente pour retenter...<br>
                Si vous ne parvenez pas à vous souvenir de votre mot de passe, une seule chose à faire : par FTP,
                supprimez le fichier <b>&quot;$DATA_DIR/passwd.dat&quot;</b> puis rendez-vous à l'URL de ce script
                pour fixer un nouveau mot de passe.");
    }
    ## Vérif paramétrage effectué ##
    if (!$CONF{'config_param'}) {    ( ($form{'ORDadmin_param_do'} eq '') && (&admin_param) ) || (&admin_param_do);  }
    &admin;
    exit(0);
  }
  ## sinon retour à l'utilisation publique normale
}
################################################
################################################
sub msg_fin {
my ($titre,$tip)=@_;
my ($d1,$d2);


  ## ATTENTION, si vous modifiez ou supprimez les lignes ci-dessous, vous ne #
  ## respectez pas les conditions d'utilisation gratuite de ce programme, et #
  ## vous vous en servez de manière illégale ! Merci de respecter le travail #
  ## de l'auteur !        Merci de votre compréhension.                      #
  print qq|<html>
  <head>
   <title>$CONF{CGI_NAME} - Administration</title>
   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
   <style><!-- A:link {text-decoration: none; color: #0000FF}  A:visited {text-decoration: none; color: #0000FF}  A:hover {text-decoration: underline; color: #0000FF}  --></style>
  </head>
  <body bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#0000FF" alink="#0000FF">
  <p>&nbsp;</p>
  <div align="center"><center>
  <table border="0" width="80%" cellspacing="1" cellpadding="0">
    <tr><td width="100%" bgcolor="#E7BD30" align="center" style="border: 1px solid rgb(0,0,128)"><font face="Arial" size="3" color="#000080"><b>$CONF{'CGI_NAME'} : <i>$titre</i></b></font></td></tr>
    <tr><td width="100%" bgcolor="#DDDDDD" style="border: 1px solid rgb(0,0,0); padding: 5px"><font face="Arial" size="2"><p>&nbsp;</p>$tip<p>&nbsp;</p></font></tr>
    <tr><td width="100%" bgcolor="#E7BD30" align="center" style="border: 1px solid rgb(0,0,128)"><font face="Arial" size="1" color="#000080"><b>Script CGI Perl gratuit disponible sur <a href="http://www.perl-gratuit.com">perl-gratuit.com</a>. v$VERSION &copy;</b></font></td></tr>
  </table></center></div>
  </body>
  </html>|;
  exit(0);
  ## ATTENTION, si vous modifiez ou supprimez les lignes ci-dessus, vous ne  #
  ## respectez pas les conditions d'utilisation gratuite de ce programme, et #
  ## vous vous en servez de manière illégale ! Merci de respecter le travail #
  ## de l'auteur !        Merci de votre compréhension.                      #
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin {

  if ($form{'ORDadmin_changepass'})         { &admin_changepass;
  } elsif ($form{'ORDadmin_changepass_do'}) { &admin_changepass_do;
  } elsif ($form{'ORDadmin_version'})       { &admin_version;
  } elsif ($form{'ORDadmin_info'})          { &admin_info;
  } elsif ($form{'ORDadmin_param'})         { &admin_param;
  } elsif ($form{'ORDadmin_param_do'})      { &admin_param_do;
  } else                                    { &admin_menu;
  }
  exit(0);
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin_menu {
my (%tmpl)=();
  $tmpl{'EMAIL_WEBMASTER'}=$CONF{'EMAIL_WEBMASTER'};
  $tmpl{'MAILPROG'}=$CONF{'MAILPROG'};
  $tmpl{'couleur_pixel'}= $CONF{'PIXEL_ISWHITE'} ? 'Blanc' : 'Noir';
  $tmpl{'TIME_OFFSET'}=$CONF{'TIME_OFFSET'}>=0 ? "+$CONF{'TIME_OFFSET'}" : "$CONF{'TIME_OFFSET'}";
  
  &msg_fin("Menu Administration",qq|
          <div align="center"><center>
          <table border="0" cellspacing="1" cellpadding="0">
           <tr> <td colspan="2" align="center"><font face="Arial" size="2" color="#800000"><b>Vos paramètres :</b></font></td> </tr>
           <tr> <td>$FONT E-Mail administrateur :</font></td>     <td>$FONT $tmpl{EMAIL_WEBMASTER}</font></td> </tr>
           <tr> <td>$FONT Emplacement sendmail :</font></td>      <td>$FONT $tmpl{MAILPROG}</font></td> </tr>
           <tr> <td>$FONT Couleur du pixel affiché :</font></td>  <td>$FONT $tmpl{couleur_pixel}</font></td> </tr>
           <tr> <td>$FONT Décalage horaire :</font></td>          <td>$FONT $tmpl{TIME_OFFSET} h</font></td> </tr>
          </table>
          <br>
          
          <form method="POST" action="$CONF{CGI_URL}">
          <input type="hidden" name="PASSWD" VALUE="$form{PASSWD}">
          <table border="0" cellspacing="1">
          <tr><td align="center"><B><font face="Arial" color="#800000">Menu :</font></B></td></tr>
          <tr><td style="border: 1px solid #800000; padding: 8px"><font face="Arial" size="2">
            <input type="submit" value="&gt;&gt;" name="ORDadmin_param"> Modifier vos paramètres.<br>
            <input type="submit" value="&gt;&gt;" name="ORDadmin_changepass"> Modifier votre mot de passe.<br>
            <input type="submit" value="&gt;&gt;" name="ORDadmin_version"> Dernière version disponible.<br>
            <input type="submit" value="&gt;&gt;" name="ORDadmin_info"> DOCUMENTATION / INFORMATIONS A LIRE
            </font></td>
          </tr>
          </table>
          </form>
          </center></div>|);
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin_changepass {

  &msg_fin("Modification du mot de passe Administrateur",
           "<p align=\"center\">$FONT Choisissez votre nouveau mot de passe Administrateur de ce script (4 à 8 caractères).</font></p>
            <form action=\"$CONF{'CGI_URL'}\" method=\"POST\">
            <input type=\"hidden\" name=\"PASSWD\" value=\"$form{'PASSWD'}\">
            <div align=\"center\"><center><table border=\"0\">
            <tr><td>$FONT Nouveau mot de passe :</font></td> <td><input type=\"text\" name=\"new_passwd\" size=\"8\"></td></tr>
            <tr><td>$FONT Nouveau mot de passe (confirmation) :</font></td> <td><input type=\"text\" name=\"new_passwdbis\" size=\"8\"></td></tr>
            <tr><td colspan=\"2\" align=\"center\"> <input type=\"submit\" name=\"ORDadmin_changepass_do\" value=\"Enregistrer ce nouveau mot de passe\"> <input type=\"submit\" value=\"Annuler\"> </td></tr>
            </table></center></div></form>\n");
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin_changepass_do {

  if (length($form{'new_passwd'}) < 4)               { &msg_fin("ERREUR !","Le mot de passe <b>$form{new_passwd}</b> fait moins de 4 caractères, ce qui est dangereux !");}
  if ($form{'new_passwd'} ne $form{'new_passwdbis'}) { &msg_fin("ERREUR !","Les deux cases de mot de passe ne sont pas identiques");}

  $CONF{'CPASSWD'}=crypt($form{'new_passwd'},'aa');
  open (PASSW,">$DATA_DIR/passwd.dat") || (&msg_fin("ERREUR !","Impossible d'enregistrer dans le fichier <b>$DATA_DIR/passwd.dat</b> ($!), veuillez vérifier le chmod 777 du répertoire <b>$DATA_DIR</b>: $!"));
  print PASSW "$CONF{'CPASSWD'}";
  close (PASSW);
  eval{ chmod(0666,"$DATA_DIR/passwd.dat");};

  $form{'PASSWD'}=$form{'new_passwd'};
  &msg_fin("Mot de passe Administrateur modifié",
           "<blockquote>
             <p>$FONT Le mot de passe pour l'accès Administrateur a été modifié et est
                maintenant <font color=\"#FF0000\">$form{'new_passwd'}</font>. Attention, il est sauvegardé de façon cryptée.
                Vous ne pourrez pas (ce programme non plus) le décrypter. Si vous l'oubliez, lorsque
                vous tenterez d'accéder ici avec un mauvais mot de passe, un message vous expliquera comment faire.
             </font></p>
             <center><form action=\"$CONF{'CGI_URL'}\" method=\"POST\"><input type=\"hidden\" name=\"PASSWD\" value=\"$form{'new_passwd'}\"><input type=\"submit\" value=\"Cliquez ici pour continuer\"></form></center>
             </blockquote>\n");
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin_param {
my (%tmpl);

  if (!$CONF{'config_param'}) {
    $CONF{'PIXEL_ISWHITE'}=0;
    $CONF{'TIME_OFFSET'}=0;
  }

  $tmpl{'CGI0_URL'}       =&formfield_encode($CONF{'CGI0_URL'});
  $tmpl{'EMAIL_WEBMASTER'}=&formfield_encode($CONF{'EMAIL_WEBMASTER'});
  $tmpl{'MAILPROG'}       =&formfield_encode($CONF{'MAILPROG'});
  $tmpl{'PIXEL_ISWHITE_ON'} =$CONF{'PIXEL_ISWHITE'} ? ' checked' : '';
  $tmpl{'PIXEL_ISWHITE_OFF'}=$CONF{'PIXEL_ISWHITE'} ? '' : ' checked';

  {## Décalage horaire ##
    my ($hh,$mm)=(localtime(time()))[2,1];
    $tmpl{'curtime'}=sprintf("%02d h %02d mn",$hh,$mm);
    for my $i (-8..8) { $tmpl{'TIME_OFFSET'}.="<option value=\"$i\"".($i==$CONF{'TIME_OFFSET'} ? ' selected':'').">".sprintf("%02d h %02d ",($hh+$i) % 24,$mm).($i>=0 ? "(+$i)" : "($i)")."</option>"; }
  }## /Décalage horaire ##

  ## Recherche des emplacements de sendmail, aux endroits classiques sur Unix/Linux
  foreach ('/usr/lib/sendmail','/usr/bin/sendmail','/bin/sendmail','/usr/sbin/sendmail','/usr/local/bin/sendmail','/usr/local/lib/sendmail') {
    if ((-e $_) && (-x $_)) { $tmpl{'guessed_sendmail'}.="$_<br>"; }
  }
  if ($tmpl{'guessed_sendmail'} eq'') { $tmpl{'guessed_sendmail'}='<i>Aucun</i>';}

  &msg_fin("Configuration",qq|
          <form action="$CONF{CGI_URL}" method="POST">
          <input type="hidden" name="PASSWD" value="$form{'PASSWD'}">
          <div align="center"><center>
          <table width="80%" border="0" cellpadding="5">
          <tr valign="top">
            <td>$FONT<B>URL complète exacte de ce script :</b><br>
             Merci de vérifier que l'URL indiquée ici est correcte.
             C'est celle-ci qui sera utilisée pour les visiteurs.</font></td>
            <td><input type="text" name="CGI0_URL" size="20" value="$tmpl{CGI0_URL}"></td>
          </tr> <tr>
            <td>$FONT<B>E-Mail Webmaster :</B><br>Tapez ici votre adresse E-Mail</font></td>
            <td nowrap><input name="EMAIL_WEBMASTER" VALUE="$tmpl{EMAIL_WEBMASTER}" size="20"></td>
          </tr><tr valign="top">
            <td>$FONT<B>Emplacement de sendmail :</B><br>
             Indiquez ici l'emplacement du programme sendmail sur votre serveur. A noter que ce script
             tente de le trouver tout seul en cherchant aux endroits habituels, mais il se peut qu'il
             ne le trouve pas. Si vous ne le connaissez pas demandez à votre hébergeur.</font></td>
            <td nowrap><input type="text" name="MAILPROG" size="20" value="$tmpl{MAILPROG}"><br>
             $FONT<u>Emplacement(s) détecté(s):</u><br>$tmpl{'guessed_sendmail'}</font></td>
          </tr><tr valign="top">
            <td>$FONT<B>Couleur du pixel renvoyé :</B><br>
             Le code HTML (inséré dans les pages de votre choix pour vous avertir des visites) génère
             une image minuscule de 1 point (1 pixel). Celle-ci peut être blanche ou noire.</font></td>
            <td nowrap>$FONT
            <input type="radio" name="PIXEL_ISWHITE" value="1" $tmpl{PIXEL_ISWHITE_ON}>Blanc<br>
            <input type="radio" name="PIXEL_ISWHITE" value="0" $tmpl{PIXEL_ISWHITE_OFF}>Noir</font></td>
          </tr><tr valign="top">
            <td>$FONT<B>Décalage horaire :</B><br>
             Afin de connaître le décalage horaire, merci de sélectionner votre heure locale dans le menu
             déroulant.</font></td>
            <td nowrap><select name="TIME_OFFSET" size="1">$tmpl{TIME_OFFSET}</select><br>
            $FONT<u>Heure-serveur actuelle:</u><br>$tmpl{curtime}</font></td>
          </tr>
          </table>
          
          <input type="submit" name="ORDadmin_param_do" value="VALIDER !"> <input type="submit" name="ORDadmin_menu" value="Annuler">
          </center></div>
          </form>|);
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin_param_do {

  # CGI0_URL
  if ($form{'CGI0_URL'} eq '') {     &msg_fin("ERREUR !","Vous n'avez pas indiqué l'URL de ce script.");}
  if ($form{'CGI0_URL'}!~ m|^https*://|) { &msg_fin("ERREUR !","L'URL de ce script doit commencer par <i>http://</i> ou <i>https://</i>");}
  $CONF{'CGI0_URL'}=$form{'CGI0_URL'};
  # EMAIL_WEBMASTER
  if (!&verify_email($form{'EMAIL_WEBMASTER'})) { &msg_fin("ERREUR !","Adresse E-Mail webmaster invalide<br>&nbsp;<br>Merci de corriger...");}
  $CONF{'EMAIL_WEBMASTER'}=$form{'EMAIL_WEBMASTER'};
  # MAILPROG
  if ($form{'MAILPROG'} eq '') { &msg_fin("ERREUR !","Vous n'avez pas indiqué l'emplacement de sendmail. Ceci est indispensable pour les envois d'E-Mails.");  }
  if (!-e "$form{MAILPROG}") {   &msg_fin("ERREUR !","Emplacement de sendmail incorrect");}
  $CONF{'MAILPROG'}=$form{'MAILPROG'};
  # PIXEL_ISWHITE
  $CONF{'PIXEL_ISWHITE'}=int($form{'PIXEL_ISWHITE'});
  # TIME_OFFSET
  $CONF{'TIME_OFFSET'}=int($form{'TIME_OFFSET'});
  # SAVE IT'S DONE:
  $CONF{config_param}=1;
  
  ## ENREGISTREMENTS PARAMS ##
  eval{chmod(0777,"$DATA_DIR/config.dat");};
  open (CONFW,">$DATA_DIR/config.dat") ||  (&msg_fin("ERREUR !","Impossible de réécrire <b>$DATA_DIR/config.dat</b> : $!<br> Merci de mettre chmod 777 manuellement à ce fichier et au répertoire... "));
  foreach ('config_param','CGI0_URL','EMAIL_WEBMASTER','MAILPROG','PIXEL_ISWHITE','TIME_OFFSET') {
    $CONF{$_}=~ s/\n/\|\\n\|/gs;
    print CONFW ("$_\t$CONF{$_}\n");
  }
  close (CONFW);
  ## /ENREGISTREMENTS PARAMS ##

  &msg_fin("Configuration",
           "<p align=\"center\">$FONT Paramètres de configuration enregistrés avec succès !<br> </font></p>
            <center><form action=\"$CONF{'CGI_URL'}\" method=\"POST\"><input type=\"hidden\" name=\"PASSWD\" value=\"$form{PASSWD}\"><input type=\"submit\" name=\"ORDadmin_menu\" value=\"Cliquez ici pour continuer\"></form></center>");
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin_version {
my %tmpl=();
  $tmpl{'CGI_NAME_fted'}=lc($CONF{CGI_NAME}); # formatted
  $tmpl{'CGI_NAME_fted'}=~ s/\s/_/gs;

  &msg_fin("Dernière version disponible",qq|
    <blockquote>
      <p><font face="Arial" size="2">Cette page vous indique <u>en temps réel</u> s'il existe
      une version plus récente de ce script CGI Perl sur notre site perl-gratuit.com. Si vous constatez
      que c'est le cas, vous pouvez aller y consulter le détail des ajouts ou corrections
      éventuelles de ce CGI, et télécharger/installer la nouvelle version.</font></p>
    </blockquote>
    <div align="center"><center>
    <table border="0" cellpadding="2" cellspacing="1">
      <tr>
        <td><font face="Arial" size="2"><b>Version utilisée ici :</b></font></td>
        <td><font face="Arial" size="2" color="#0000FF"><b>$VERSION</b></font></td>
      </tr> <tr>
        <td><font face="Arial" size="2"><b>Dernière version disponible : &nbsp; </b></font></td>
        <td><img src="$CONF{'IMGCGI_URL'}/$tmpl{CGI_NAME_fted}_vnumber.gif" border="0"></td>
      </tr>
    </table>
    <p>$FONT
     Remarque éventuelle sur la dernière version :<br><img src="$CONF{'IMGCGI_URL'}/$tmpl{CGI_NAME_fted}_vnote.gif" border="0"><br> &nbsp;<br>
     Vous trouverez la dernière version disponible sur <a href="http://www.perl-gratuit.com" target="_blank">Perl-Gratuit.com</a>
    </font></p>
    <form action="$CONF{CGI_URL}" METHOD="POST"><input type="hidden" name="PASSWD" value="$form{PASSWD}"><input type="submit" value="Retour Menu"></form>
    </center></div>|);
}
################################################
#### ATTENTION, réutilisation/recopie du    ####
#### code source interdite et illégale      ####
################################################
sub admin_info {
my (%tmpl)=();

  $tmpl{'form'}=&formfield_encode($CONF{'theform'});

  &msg_fin("Documentation / Informations à lire",qq|
    <p align="center"><font face="Arial" color="#800000" size="3"><b>Informations sur l'utilisation de $CONF{CGI_NAME} :</b></font></p>
    
    <p><font face="Arial" size="2"><font color="#800000"><b>Accès à l'administration :</b></font><br>
     Pour accéder à la section d'administration de $CONF{CGI_NAME} rendez-vous à l'URL exacte : <br>
     <a href="http://$ENV{SERVER_NAME}$CONF{CGI_URL}?admin">http://$ENV{SERVER_NAME}$CONF{CGI_URL}?admin</a><br>
     Mettez cette URL dans vos favoris pour ne pas l'oublier ! Votre mot de passe sera ensuite demandé.</font></p>
    
    <p><font face="Arial" size="2"><font color="#800000"><b>Intégration dans votre site :</b></font><br>
    Code HTML à insérer dans la (ou les) page(s) HTML de votre choix (de préférence tout en haut sous &lt;body&gt;) :<br>
    <i>A chaque fois qu'un visiteur se rendra sur une page contenant ce code HTML, vous serez prévenu par un E-Mail
    contenant diverses informations sur cette visite. Particulièrement utile concernant les pages protégées...</i>
    <form action="" method="get"><textarea name="htmlcode" rows="8" cols="60" wrap="off">$tmpl{form}</textarea></form>
    
    <p><font face="Arial" size="2"><font color="#800000"><b>NOTES :</b></font><br>
    - Etant donné que ce script vous envoie un E-Mail à chaque fois que la (ou les) page(s) contenant le code HTML
    ci-dessus est visitée, vous risquez d'être submergé d'E-Mails de PG-AgentSecret si vous avez un très fort
    trafic. Donc, attention à utiliser cela avec modération.<br>
    - LIMITES : Ce script ne peut pas donner les adresses E-mail de vos visiteurs. Plus précisément aucun script
    ne le peut. Personne ne peut connaître l'adresse E-Mail d'un visiteur à son insu. Le mieux est de demander
    aux visiteurs de s'inscrire à votre mailing-liste...<br>
    (nous proposons également sur notre site des scripts CGI Perl de gestion de mailing-liste)</font></p>
    
    <p><font face="Arial" size="2"><font color="#800000"><b>Copyright - Licence d'utilisation :</b></font><br>
    Un droit d'utilisation gratuite de ce script CGI Perl vous est accordé à la condition expresse de ne pas
    le modifier du tout, ni de le réutiliser ou recopier en tout ou partie, revendre, louer, redistribuer, etc.
    Tous les droits autres que l'utilisation gratuite sont réservés (nous contacter au besoin).
    Toute contrefaçon ou autre violation des droits de propriété intellectuelle fait l'objet de poursuites.
    IL EST PAR-DESSUS TOUT INTERDIT DE MODIFIER LES MENTIONS DE L'AUTEUR (COPYRIGHT, NOM ET LIEN VERS LE SITE
    DE L'AUTEUR,ETC). CECI EST LA CONTREPARTIE DE LA GRATUITÉ.<br>
    Tout simplement, merci de respecter le travail de l'auteur... afin que nous puissions continuer à vous
    proposer de tels scripts CGI Perl.</font></p>
    
    <p><font face="Arial" size="2"><font color="#800000"><b>Nous proposons également des scripts PRO :</b></font><br>
    En plus des scripts gratuits disponibles sur Perl-Gratuit.com, nous proposons des scripts PRO
    dédiés à un usage professionnel dont les principales caractéristiques sont :<br>
    - aucune mention de l'auteur ni copyright visible par le visiteur.<br>
    - personnalisation complète de l'affichage pour une bonne intégration à votre site.<br>
    - assistance, support technique privilégié et ultra-prioritaire, documentation complète en ligne.<br>
    - installation offerte sur demande.<br>
    - nombreuses fontionnalités supplémentaires, etc...<br>
    Pour consulter les scripts PRO disponibles et en acquérir éventuellement une licence,
    merci de vous rendre sur notre autre site: <a href="http://www.perl-pro.com/" target="_blank">Perl-PRO.com</a>
    </font></p>
    
    <center>
     <form action="$CONF{CGI_URL}" method="POST"><input type="hidden" name="PASSWD" value="$form{PASSWD}"><input type="submit" value="Retour Menu"></form>
    </center>
  |);
}
################################################
################################################