#!/usr/bin/perl

#
#  ResooSite v.0.9.4 - Resoo 2002-2003
#  resoouploadadmin.pl
#
# basé sur psupload script

use CGI; # charge le module CGI.pm
my $GET = new CGI; # créer un nouvel objet
my @VAL = $GET->param; # récupère tous les noms de champs du formulaire

foreach(@VAL){
	$FORM{$_} = $GET->param($_); # mettre tous les champs et valeur en hash 
}

my @files;
foreach(keys %FORM){
	if($_ =~ /^FILE/){
		push(@files, $_); # placer le nom de champs in array
	}
}

if ($FORM{'myuprep'}){
	$myuprep="$FORM{'myuprep'}";
}


require "resooconf.pl";

if ($FORM{'util'}){
	$util="$FORM{'util'}";
}

if ($FORM{'pass'}){
    $pass="$FORM{'pass'}";
}

&verify;

#################################################################### 

# Configuration utilisateur

require "resoouploadconf.pl";

# les répertoires ouverts au téléchargement

#@myupreplist = qw~
#doc
#~;

# le chemin absolu du répertoire de destination des fichiers.
# par ex: /var/www/html/images
# ne pas terminer le chemin par un slash
# CHMOD 777 /var/www/html/images (permission en écriture)

#$urldir = "$domainurl/$myuprep";

# URL absolue du même répertoire
# par ex: http://votreserveur.com/images/

#$folder = "$server/$dir/$myuprep/";

# si le script est appelé directement (sans paramètre)
# 0 : affiche un message d'erreur
# x : affiche un formulaire de téléchargement (ou x est le nombre de champs fichier)

#$printform = 3;

# sécurité :
# pour n'accepter les téléchargement que depuis un domaine précis
# entrer ici ce nom de domaine (ou une partie du nom de domaine)
# le laisser vide ("") pour accepter toutes les sources.

#$domain = "";

# lorsque le téléchargement à réussi, entrer l'URL de la page vers laquelle
# le client est redirigé.
# le laisser vide ("") pour avoir l'affichage du message par défaut.

#$redirect = "";

# si vous voulez être prévenus à chaque téléchargement, indiquez une adresse email
# le laisser vide pour ne rien recevoir.

#$notify = 'vous@votreserveur.com';
#$notify = '';

# si vous donnez une valeur à $notify, vous devez indiquer le chemin pour accèder
# à sendmail sur le serveur. (par ex : /usr/sbin/sendmail)

#$send_mail_path = "/usr/sbin/sendmail";

# 1 : le message par défaut après un téléchargement réussi (seulement si $redirect est vide)
#     listera les fichiers présent dans le répertoire de destination.
# 0 : les fichiers ne seront pas listés.

#$print_contents = 0;

# permettre l'écrasement de fichiers : 1 = oui, 0 = non (0 renommera les fichiers en
# ajoutant un nombre à fin de leur nom).

#$overwrite = 1;

# forcer le téléchargement des fichiers en minuscules
# 1 = oui, 0 = non (ne rien changer)

#$lowercase = 1;

# change l'extension .jpeg en .jpg
# 1 = oui, 0 = non (ne rien changer)

#$jpegjpg = 1;

# types de fichiers acceptés en téléchargement, une nouvelle ligne par type de fichier
# entrez le mot "ALL" (en majuscule) pour les accepter tous.

#@types = qw~
#mp3
#~;

# taille maxi de chaque fichier (kb)

#$max = 8000;

####################################################################
#    fin configuration
####################################################################

$folder =~ s/(\/|\\)$//ig;

$S{S} = "/"; # séparateur utilisé dans les chemins

#$ScriptURL = "http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";
#$ScriptURL = "$server$ENV{'SCRIPT_NAME'}";
$ScriptURL = "resoouploadadmin.pl";

unless (-d "$urldir"){
	mkdir ("$urldir", 0777); # à moins que le répertoire n'existe, le créer (et l autoriser en écriture)
	chmod(0777, "$urldir");
}

unless (-d "$urldir"){
	# si le répertoire n'existe toujours pas, le chemin indiqué par $urldir est faux
	print qq~Content-type: text/html\n\n~;
	&head;
	print "<br><br>\n";
	
	print qq~
	<table width="600">
	<tr>
	<td>
	
	$font
	<b>Le chemin indiqué est incorrect.</b> La variable \$urldir indique : "$urldir"
	<p>
	Votre racine est : $ENV{DOCUMENT_ROOT}
	<p>
	Le chemin doit contenir l\'adresse de la racine suivi par un slash (/), suivi par
	le nom du répertoire de destination.
	<p>
	Quelques fois l\'adresse de la racine retourné ci dessus peut ne pas être exacte. 
	Dans ce cas si vous avez accès à votre site par telnet ou ssh, utilisez la commande pwd 
	à l\'intérieur de votre répertoire de destination pour en connaître l\'adresse. 
	Cette adresse doit figurer dans la variable \$urldir.
	$finfont
	
	</td>
	</tr>
	</table>
	~;

	&bouton;
	&foot; # afficher footer
	exit;
}

#if(!$VAL[0]){
if(!$files[0]){
    if ($printform == "0"){
	# pas de champs de formulaire
	print qq~Content-type: text/html\n\n~;
	&head; # afficher header
	print "<br><br>\n";
	
	print qq~
	<table width="760">
	<tr>
	<td>
	
	$font
	<p>
	Ce script doit être appelé à partir d\'un formulaire.<br>
	Le formulaire doit pointer vers le script.<br>
	Le tag du formulaire doit contenir les attributs :<br>
	<p>
	&lt;form <font color="#FF0000">action</font>="$ScriptURL" <font color="#FF0000">method</font>="post" <font color="#FF0000">enctype</font>="multipart/form-data"> 
	<p>
	<li><font color="#FF0000">method</font> doit être egal à <font color="#FF0000">post</font>.</li>
	<li><font color="#FF0000">enctype</font> doit être égal à <font color="#FF0000">multipart/form-data</font>.</li>
	<li><font color="#FF0000">action</font> doit pointer vers le script.</li>
	<p>
	Si vous lisez ce message, copiez / collez l\'exemple ci-dessus dans le formulaire, les valeurs devraient être correctes.
	$finfont
	
	</td>
	</tr>
	</table>
	~;
	
	&bouton;
	&foot;
	exit;
    }
    else {
	# pas de champs de formulaire = affiche un formulaire avec $printform champs fichiers
	print qq~Content-type: text/html\n\n~;
	&head; # afficher header
	print "<br><br>\n";

	print qq~
	<center>
	<table width="600">
	<tr>
	<td>

	$fonttitre
	Page Téléchargement
	$finfonttitre
	$font<center>
	<form action="$ScriptURL" method="post" enctype="multipart/form-data">
	~;
	&PrintField; # créer x champs FILE (x = $printform)
	print qq~
	<input type="Submit" value=" envoyer ">
	</form>
	$finfont</center>
	
	</td>
	</tr>
	</table>
	</center>
	~;
	
	&bouton;
	&foot;
	exit;
    }
}

# vérifie le domaine (sécurité)
if($domain =~ /\w+/){
	if($ENV{HTTP_REFERER} !~ /$domain/i){
		print qq~Content-type: text/html\n\n~;
		&head; # affiche header
		print "<br><br>\n";
		
		print qq~
		<table width="600">
		<tr>
		<td>

		$font
		provenance: $ENV{HTTP_REFERER}
		<p>
		Votre nom de domaine n\'est pas autorisé à utiliser ce script.
		$finfont

		</td>
		</tr>
		</table>
		~;

		&bouton;
		&foot; # affiche footer
		exit;
	}
}

my $failed; # retourne la chaine = false
my $selected; # nombre de fichier selectionner par l'utilisateur

#################################################################### 

#################################################################### 

foreach (@files){
	# télécharge chaque fichier, passe le champs NAME du formulaire s'il a une valeur
	if($GET->param($_)){
		
		# si le champs contient un nom de fichier, exécute la routine &upload_now
		# le nom et le chemin du fichier sont passé à la routine
		$returned = &upload_now($_); 
		
		if($returned =~ /^Success/i){
			# si le message $returned commence par "Success" le téléchargement est réussi
			# supprime le mot "Success" et tous les espaces, seul reste le nom du fichier  
			$returned =~ s/^Success\s+//;
			push(@success, $returned);
		} else {
			# sinon, si le mot "success" n'est pas retourné, le message indique l'erreur rencontrée. 
			# ajoute l'erreur à la variable $failed
			$failed .= $returned;
		}
		$selected++; # incremente le nombre de fichiers selectionnés par l'utilisateur
	}
}

if(!$selected){
	# aucun fichiers selectionnés par l'utilisateur, aucune valeur n'est retournée dans les variables
	$failed .= qq~<li>Aucun fichier n\'est sélectionné.~;
}

# si aucun message d'erreur n'est retourné, le téléchargement est réussi

my ($fNames, $aa, $bb, @current, @currentfiles );

if($failed){

	print qq~Content-type: text/html\n\n~;
	&head;	
	print "<br><br>\n";
	
	print qq~
	<table align="center" width="600">
	<tr>
	<td>$font
	
	Le téléchargement d\'un ou plusieurs fichiers à <b>échoué</b>. Les raisons retournées par le script sont: 
	<p>
	
	$failed
	<p>
	~;
	
	if($success[0]){
		# envoi un email si une adresse email est disponible ($notify)
		if(check_email($notify)){
			
			# le message qui sera envoyé :
			my $message = qq~
			Les fichiers suivants ont été téléchargés sur le serveur :
			~; 
			
			$folder =~ s/(\/|\\)$//ig;
			foreach(@success){
				$message .= qq~
				$folder/$_	
				~;
			}
			
			$CONFIG{mailprogram} = $send_mail_path;
			# (from e-mail, from name, to e-mail, to name, subject, body)
			&send_mail($notify, 'ResooUpload serveur', $notify, 'ResooUpload admin', 'Rapport ResooUpload', $message);
		}
	
		print qq~
		<p>
		Les fichiers suivants ont été téléchargés <b>avec succès</b> sur le serveur :
		<p>
		~;	
		foreach(@success){
			print qq~
			<li><b>
			$_</b><p>~;
		}
	}
	
	print qq~
	$finfont</td>
	</tr>
	</table>
	~;
	
	&bouton;
	&foot;	
	
} else {
	# le téléchargement a réussi
	
	# ajoute un lien pour chaque fichier
	$folder =~ s/(\/|\\)$//ig;
	
	# envoi un email si une adresse email est disponible ($notify)
	if(check_email($notify)){
		
		# le message qui sera envoyé
		my $message = qq~
		Les fichiers suivants ont été téléchargés sur le serveur :
		~; 
		
		foreach(@success){
			$message .= qq~
			$folder/$_	
			~;
		}
		
		$CONFIG{mailprogram} = $send_mail_path;
		# (from e-mail, from name, to e-mail, to name, subject, body)
		&send_mail($notify, 'Demo Upload', $notify, 'Demo Upload', 'Upload Notification', $message);
			
	}
	
	if($redirect){
		# redirige l'utilisateur vers la page $redirect
		print qq~Location: $redirect\n\n~;
	} else {
		# affiche le message "réussite" par défaut
		
		print qq~Content-type: text/html\n\n~;
		&head;	
		print "<br><br>\n";
		
		print qq~
		<table align="center" width="500">
		<tr>
		<th>$fontgrande Succès $finfontgrande</th>
		</tr>
		<tr>
		<td>$font Les fichiers suivants ont été téléchargés avec succès : 
		<p>
		~;
		
		foreach(@success){
			print qq~
			<li><b> 
			$_</b><p>~;
		}
		
		print qq~
		</font></td>
		</tr>
		</table>
		<br>
		~;
		
		if($print_contents){
			print qq~
			<table align="center" width="500">
			<tr><td>$font<b>Actuellement dans le répertoire :</b>$finfont</td></tr>
			<tr>
			<td valign="top">
			$font
			~;
			
			opendir(DIR, "$urldir");
			@current = readdir(DIR);
			closedir(DIR);
			
			foreach(@current){
				unless($_ eq '.' || $_ eq '..'){
					push(@currentfiles, $_);
				}
			}
			
			@currentfiles = sort { uc($a) cmp uc($b) } @currentfiles;
			
			for($aa = 0; $aa <= int($#currentfiles / 2); $aa++){
				print qq~
				<b>&#149;</b> 
				<a href="$folder/$currentfiles[$aa]" target="_blank">$currentfiles[$aa]</a><br>
				~;
			}
			
			print qq~$finfont</td><td valign="top">$font~;
			
			for($bb = $aa; $bb < @currentfiles; $bb++){
				print qq~
				<b>&#149;</b> 
				<a href="$folder/$currentfiles[$bb]" target="_blank">$currentfiles[$bb]</a><br>
				~;
			}
			
			
			print qq~
			$finfont</td>
			</tr>
			</table>~;
		}
		
		print qq~
<br>
<center>$fontpetite
ResooUpload <a href="http://www.resoo.net">&copy; Resoo.net</a>
$finfontpetite</center>
~;
		
		&bouton;
		&foot;	
	
	}
}

#################################################################### 

#################################################################### 

sub upload_now {

	my ( $type_ok, $file_contents, $buffer, $destination ); # declare les variables

	my $file = $GET->param($_[0]); # recevoir le nom de fichier. $_[0] est l'argument passé
	
	$destination = $urldir;
	
	my $limit = $max;
	$limit *= 1024; # converti la taille maxi de kilobytes (Kb) en bytes
	
	# creer une autre copie de la variable $file. Cela permet au script de jouer avec
	# la nouvelle copie, sans affecter la première.
	my $fileName    = $file;

	# selon la valeur de $lowercase, changer la casse
	if ($lowercase == "1") {$fileName = lc($fileName);}

	# selon la valeur de $jpegjpg, changer l'ext. jpeg en jpg
	if ($jpegjpg == "1") {
	    if ($fileName =~ m/jpeg$/) {$fileName =~ s/\.jpeg/\.jpg/;}
	}

	# récupère l'extension du fichier
	my @file_type   = split(/\./, $fileName);

	# on considère que ce qui suit le dernier "." est l'extension
	my $file_type   = $file_type[$#file_type];

#	$file_type =~ s/jpeg/jpg/;
	
	# récupère le nom de fichier, pour cela supprime tout ce qui précède (en l'incluant)
	# le dernier slash trouvé ( que ce soit un slash ou un antislash )
	$fileName =~ s/^.*(\\|\/)//;
	
	# supprime tous les espace de la nouvelle variable $filename 
	$fileName =~ s/\s+/\_/ig;
	
	# vérifie les caractères non alpha-numeriques dans $filename (mais protège les . - et _)
	$fileName =~ s/\./Upoint/g;
	$fileName =~ s/\-/Utiret/g;
	$fileName =~ s/\_/Uunder/g;
	if($fileName =~ /\W/){
		$fileName =~ s/\W/_/ig; # remplace tous les autres par un "_"
	}
	$fileName =~ s/Upoint/\./g;
	$fileName =~ s/Utiret/\-/g;
	$fileName =~ s/Uunder/\_/g;
	
	# si $file_type correspond à un type specifié (@types), rend la variable $type_ok vrai
	for($b = 0; $b < @types; $b++){
		if($file_type =~ /^$types[$b]$/i){
			$type_ok++;
		}
		if($types[$b] eq "ALL"){
			$type_ok++; # idem si le mot-clé ALL est trouvé.
		}
	}
	
	# si ok, contrôle la permission d'écrasement
	if($type_ok){
		if(!$overwrite){ # si $overwite = 0 ou faux, renomme le fichier avec la routine check_file
			$fileName = check_file($destination,$fileName);
		}
		# créer un nouveau fichier sur le serveur avec la nouvelle copie préparée de filename
		if(open(NEW, ">$destination$S{S}$fileName")){
			# commence à lire le disque dur de l'utilisateur (1 kb par 1kb).
			while (read($file, $buffer, 1024)){ 
				# écrit chaque kb dans le nouveau fichier sur le serveur 
				print NEW $buffer; 
			}
			# fermer le nouveau fichier sur le serveur
			close NEW;
		} else {
			# retourne le message d'erreur du serveur si le nouveau fichier ne peurt être créé
			return qq~<li>Error: Impossible de créer un nouveau fichier sur le serveur. $!~;
		}

		# vérifie que la taille maxi ne soit pas dépassée
		if(-s "$destination$S{S}$fileName" > $limit){ # -s est la taille du fichier (en bytes)
			unlink("$destination$S{S}$fileName"); # supprime le fichier si supérieur à taille maxi
			return qq~<li>Le fichier dépasse la taille maximale : $fileName~;
		}
	} else {
		return qq~<li>Type de fichier non autorisé : $file_type~; 
	}
			
	# vérifie que le fichier a effectivement bien été téléchargé en vérifiant qu'il a une taille
	if(-s "$destination$S{S}$fileName"){
		return qq~Success $fileName~; # succès 
	} else {
		# supprime le fichier qui ne contient rien
		unlink("$destination$S{S}$fileName");
		# l'utilisateur a surement donné un chemin incorrect pour le fichier
		return qq~<li>Echec téléchargement : Aucune donnée dans $fileName. 
		Le fichier copié sur le serveur a une taille de 0 Kb. 
		Vérifier le chemin du fichier à télécharger.~; 
	}
}

#################################################################### 
# vérifie si le nom du fichier de destination existe déjà
#################################################################### 

sub check_file {
	# $urldir,$filename,$newnum sont les arguments passés à cette routine
	my ($urldir,$filename,$newnum) = @_;
	
	my (@file_type, $file_type, $exists, $bareName); 
	
	if(!$newnum){$newnum = "0";} # initialise $newnum à 0
	
	# lecture du répertoire, et listage de son contenu
	opendir(DIR, "$urldir");
	@existing_files =  readdir(DIR);
	closedir(DIR);
	
	# si le $filename passé existe déjà, affecte 1 à $exists (vrai)
	foreach(@existing_files){
		if($_ eq $filename){
			$exists = 1;
		}
	}
	
	# s'il existe déjà, renomme le fichier de destination puis vérifie à nouveau que le nom
	# n'existe pas déjà
	if($exists){
		$newnum++; # incremente $newnum (ajoute 1)

		# récupère l'extension
		@file_type   = split(/\./, $filename); # découpe le nom dans une liste en utilisant les points
		# mettre le premier élément de la liste dans la variable $barename
		$bareName    = $file_type[0]; 
		# mettre le dernier élément (après le dernier point) dans la variable $file_type (extension)
		$file_type   = $file_type[$#file_type]; 
#	$file_type =~ s/jpeg/jpg/;
		
		# enlever tout chiffre à la fin de $bareName
		$bareName =~ s/\d+$//ig;
		
		# concatener le nouveau nom en utilisant barename + newnum + extension 
		$filename = $bareName . $newnum . '.' . $file_type;
		
		# affecte 0 à $exists car le nouveau nom va être testé à nouveau
		$exists = 0;
		
		# recommence la routine avec le nouveau nom
		&check_file($urldir,$filename,$newnum);
	} else {
		# le $filename, soit sans changement, soit numéroté xxx, est maintenant unique dans
		# le répertoire, c'est le nom à utiliser
		return ($filename);
	}
}

#################################################################### 
# envoie un email
#################################################################### 

sub send_mail {
	my ($from_email, $from_name, $to_email, $to_name, $subject, $message ) = @_;
	
	if(open(MAIL, "|$CONFIG{mailprogram} -t")) {
		print MAIL "From: $from_email ($from_name)\n";
		print MAIL "To: $to_email ($to_name)\n";
		print MAIL "Subject: $subject\n";
		print MAIL "$message\n\n$ENV{REMOTE_ADDR}";
		close MAIL;
		return(1);
	} else {
		return;
	}
}

#################################################################### 
# affiche header
#################################################################### 

#sub PrintHead {
#	print qq~Content-type: text/html\n\n~;
#	print qq~
#	<html>
#	<title>ResooUpload utility</title>
#	<body bgcolor="#ffffff">
#	~;
#}

#################################################################### 
# affiche footer
#################################################################### 

#sub PrintFoot {
#	print qq~
#	</body>
#	</html>
#	~;
#}

#################################################################### 
# vérifie que l'adresse mail soit valide
#################################################################### 

sub check_email {
	my($fe_email) = $_[0];
	if($fe_email) {
		if(($fe_email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|(\.$)/) ||
		($fe_email !~ /^.+@\[?(\w|[-.])+\.[a-zA-Z]{2,3}|[0-9]{1,3}\]?$/)) {
			return;
		} else { return(1) }
	} else {
		return;
	}
}

#################################################################### 
# creer les champs du formulaire interne
#################################################################### 

sub PrintField {
    &hidden;
    print "<hr>";
    print "Répertoire de destination :  ";
    print "<select name=\"myuprep\">";
    print "<option value=\"\">Choisir un répertoire...";
    foreach $line(@myupreplist){
	print "<option value=\"$line\">$line";
    }
    print "</select><br><hr><br>";
    for($c = 1; $c < ($printform+1); $c++){
	print qq~
	Fichier \#$c :  <input type="File" name="FILE$c">
	<p>
	~;
    }
}

sub verify {
    open(MAIN,"$private/$util.txt") || &eject;
    @main = <MAIN>;
    foreach $main_line (@main) {
	$passcrypt = &resoocrypt($pass);
    	    if ($main_line =~ /^$passcrypt$/) {
		##OK##
	    }
	    else {
		&eject;
            }
      }
   close(MAIN);
}

sub bouton {
    print "<center><table width=600 border=0 cellpaddind=10>\n";
    print "<tr><td colspan=2 align=center>\n";
    print "<br><br><hr>";
    print "</td></tr>\n";
    print "<tr><td align=center>\n";
    print "$font<a href=\"resoorep.pl?doc\" target=blank>\n";
    print "Visualiser répertoire doc\n";
    print "</a>$finfont\n";
    print "</td>\n";    
    print "<td align=center>\n";
    print "$font<a href=\"resoorep.pl?img\" target=blank>\n";
    print "Visualiser répertoire img\n";
    print "</a>$finfont\n";
    print "</td></tr>\n";    
    print "</table></center>\n";    

    print "<center><table width=600 border=0 cellpaddind=10>\n";
    print "<tr><td colspan=2 align=center>\n";
    print "<hr>";
    print "</td></tr>\n";
    print "<tr><td align=center>\n";
    print "<form method=POST action=\"resoouploadadmin.pl\">\n";
    &hidden;
    print "<INPUT TYPE=SUBMIT VALUE=\"   nouveau telechargement   \">\n";
    print "</form>\n";
    print "</td>\n";    
    print "<td align=center>\n";
    print "<form method=POST action=\"resoobaoadmin.pl\">\n";
    &hidden;
    print "<INPUT TYPE=SUBMIT VALUE=\"   retour page B.A.O. admin   \">\n";
    print "</form>\n";
    print "</td></tr>\n";    
    print "</table></center>\n";    
}

sub eject {
    print qq~Content-type: text/html\n\n~;
    print qq~
    <html>
    Action non autorisée.
    </html>
    ~;
    exit;
}