#!/usr/bin/perl # # REF: resoouploadadmin.pl # ResooSite v.0.9.5 -(p)Resoo 2002-2003 # (c)2003 - pascal blain / GNU GPL - General Public License # http://www.resoo.org/resoosite # pascal@resoo.org # # inspiré par 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 en tableau } } 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\; charset=ISO-8859-1\n\n~; &head; print "

\n"; print qq~
$font Le chemin indiqué est incorrect. La variable \$urldir indique : "$urldir"

Votre racine est : $ENV{DOCUMENT_ROOT}

Le chemin doit contenir l\'adresse de la racine suivi par un slash (/), suivi par le nom du répertoire de destination.

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

~; &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\; charset=ISO-8859-1\n\n~; &head; # afficher header print "

\n"; print qq~
$font

Ce script doit être appelé à partir d\'un formulaire.
Le formulaire doit pointer vers le script.
Le tag du formulaire doit contenir les attributs :

<form action="$ScriptURL" method="post" enctype="multipart/form-data">

  • method doit être egal à post.
  • enctype doit être égal à multipart/form-data.
  • action doit pointer vers le script.
  • Si vous lisez ce message, copiez / collez l\'exemple ci-dessus dans le formulaire, les valeurs devraient être correctes. $finfont

    ~; &bouton; &foot; exit; } else { # pas de champs de formulaire = affiche un formulaire avec $printform champs fichiers print qq~Content-type: text/html\; charset=ISO-8859-1\n\n~; &head; # afficher header print "

    \n"; print qq~
    $fonttitre Page Téléchargement $finfonttitre $font
    ~; &PrintField; # créer x champs FILE (x = $printform) print qq~
    $finfont
    ~; &bouton; &foot; exit; } } # vérifie le domaine (sécurité) if($domain =~ /\w+/){ if($ENV{HTTP_REFERER} !~ /$domain/i){ print qq~Content-type: text/html\; charset=ISO-8859-1\n\n~; &head; # affiche header print "

    \n"; print qq~
    $font provenance: $ENV{HTTP_REFERER}

    Votre nom de domaine n\'est pas autorisé à utiliser ce script. $finfont

    ~; &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~
  • 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\; charset=ISO-8859-1\n\n~; &head; print "

    \n"; print qq~
    $font Le téléchargement d\'un ou plusieurs fichiers à échoué. Les raisons retournées par le script sont:

    $failed

    ~; 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~

    Les fichiers suivants ont été téléchargés avec succès sur le serveur :

    ~; foreach(@success){ print qq~

  • $_

    ~; } } print qq~ $finfont

  • ~; &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\; charset=ISO-8859-1\n\n~; &head; print "

    \n"; print qq~
    $fontgrande Succès $finfontgrande
    $font Les fichiers suivants ont été téléchargés avec succès :

    ~; foreach(@success){ print qq~

  • $_

    ~; } print qq~


  • ~; if($print_contents){ print qq~
    $fontActuellement dans le répertoire :$finfont
    $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~ $currentfiles[$aa]
    ~; } print qq~$finfont
    $font~; for($bb = $aa; $bb < @currentfiles; $bb++){ print qq~ $currentfiles[$bb]
    ~; } print qq~ $finfont
    ~; } print qq~
    $fontpetite ResooUpload © ResooSite $finfontpetite
    ~; &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~
  • 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~
  • Le fichier dépasse la taille maximale : $fileName~; } } else { return qq~
  • 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~
  • 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\; charset=ISO-8859-1\n\n~; # print qq~ # # ResooUpload utility # # ~; #} #################################################################### # affiche footer #################################################################### #sub PrintFoot { # print qq~ # # # ~; #} #################################################################### # 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 "
    "; print "Répertoire de destination : "; print "


    "; for($c = 1; $c < ($printform+1); $c++){ print qq~ Fichier \#$c :

    ~; } } sub verify { open(MAIN,"$private/$util.txt") || &eject; @main =

    ; foreach $main_line (@main) { $passcrypt = &resoocrypt($pass); if ($main_line =~ /^$passcrypt$/) { ##OK## } else { &eject; } } close(MAIN); } sub bouton { print "
    \n"; print "\n"; print "\n"; print "\n"; print "
    \n"; print "


    "; print "
    \n"; print "$font\n"; print "Visualiser répertoire doc\n"; print "$finfont\n"; print "\n"; print "$font\n"; print "Visualiser répertoire img\n"; print "$finfont\n"; print "
    \n"; print "
    \n"; print "\n"; print "\n"; print "\n"; print "
    \n"; print "
    "; print "
    \n"; print "
    \n"; &hidden; print "\n"; print "
    \n"; print "
    \n"; print "
    \n"; &hidden; print "\n"; print "
    \n"; print "
    \n"; } sub eject { print qq~Content-type: text/html\; charset=ISO-8859-1\n\n~; print qq~ Action non autorisée. ~; exit; }