Scripts Perl

Dernière mise à jour : 26/05/2016
Rendu HTML de répertoires

Énoncé

Ecrivez un script qui affichera le contenu du répertoire passé en paramètre sous forme de page html. Chaque entrée du répertoire affichée le sera sous forme de lien. S'il s'agit d'un fichier normal, lorsque nous cliquons sur le lien, le contenu du fichier s'affiche. S'il s'agit d'un répertoire, le fait de cliquer sur le lien affiche le contenu du répertoire de la manière précédemment annoncée.
Solution

#!/usr/bin/perl

################################################################################
# (c) Sébastien ADAM - Mars ~ Avril 2000                                       #
# Licence Creative Commons Attribution - Pas d'Utilisation Commerciale -       #
# Partage dans les Mêmes Conditions 2.0 Belgique.                              #
################################################################################

#******************************************************************************#
# Programme principal *********************************************************#
#******************************************************************************#

&initcolor;
print "content-type: text/html\n\n";
if(!&ReadIn) {
  $dir = "/";
}
$rdir = $ENV{'DOCUMENT_ROOT'}.$dir;
chdir $rdir || &printerror("Directory not found");
&printdir;

#******************************************************************************#
# Fin du programme principal **************************************************#
#******************************************************************************#

#******************************************************************************#
# Fonctions *******************************************************************#
#******************************************************************************#

# Affichage du contenu du répertoire ###########################################
sub printdir {
  opendir(DIR, '.') || &printerror("Can't open directory $dir");
  @dir = readdir(DIR);
  closedir(DIR);
  foreach (@dir) {
    next if /^\./;	# supprime les éléments cachés
    $type = (lstat)[2] >> 12;
    if ($type == 4) { push(@rep,$_); }	# prend les repertoires
    if ($type == 8) { push(@fich,$_); }	# prend les fichiers ordinaires
  }
  @rep = sort {uc($a) cmp uc($b)} @rep;
  @fich = sort {uc($a) cmp uc($b)} @fich;
  &printpgdir;
}

sub printpgdir {
  print <<FINPRINT;
<html>
<head>
<title>Content of $dir</title>
<head>
<body bgcolor="$couleur{'blanc'}">
<h1 align="left">Content of $dir :</H1>

FINPRINT
  if($dir ne "/") {
    print <<FINPRINT;
<p align="justify"><a href="/cgi-bin/ftp.pl?$dir/.."><img src="/icons/back.gif" border="0"> parent directory</a></p>
FINPRINT
  }
  print <<FINPRINT;
<table border="0">
<tr><td><font size="+1">Type</font><td><font size="+1">Name</font><td><font size="+1">Size</font><td><font size="+1">Date</font></tr>

FINPRINT
  foreach(@rep) {
    $date = gmtime((stat)[8]);
    print <<FINPRINT;
  <tr>
    <td><a href="/cgi-bin/ftp.pl?$dir/$_"><img src="/icons/folder.gif" border="0"></a>
    <td><a href="/cgi-bin/ftp.pl?$dir/$_">$_</a>
    <td align="right">

    <td align="right"> $date
  </tr>
FINPRINT
  }
  foreach(@fich) {
    $size = (stat)[7];
    $date = gmtime((stat)[8]);
    print <<FINPRINT;
  <tr>
    <td><a href="$dir/$_"><img src="/icons/text.gif" border="0"></a>
    <td><a href="$dir/$_">$_</a>

    <td align="right"> $size bytes
    <td align="right"> $date
  </tr>
FINPRINT
  }
  print "</table>\n</body>\n</html>\n";
}
# Fin affichage du contenu du répertoire #######################################

# Affichage d'un message d'erreur ##############################################
sub printerror {
  print <<FINPRINT;

<html>
<head>
<title>Content of $dir</title>
<head>
<body bgcolor="$couleur{'blanc'}">
<h1 align="left">Content of $dir :</H1>

<img src="/icons/alert.red.gif">
<p align="justify">There was an error when opening directory $dir :<br>
<font color="$couleur{'rouge'}">$_[0].</font></p>
</body>
</html>
FINPRINT
  die($_[0]);
}
# Fin affichage message d'erreur ###############################################

# Lecture des données entrées ##################################################
sub ReadIn {
  if($ENV{'REQUEST_METHOD'} eq "GET") {
    $dir = $ENV{'QUERY_STRING'};
  } else {
    $dir = "/";
  }
  return $dir;
}
# Fin lecture des données entrées ##############################################

# Initialisation des couleurs ##################################################
sub initcolor {
  $couleur{'noir'}  = "#000000";
  $couleur{'bleu'}  = "#0000FF";
  $couleur{'vert'}  = "#00FF00";
  $couleur{'cyan'}  = "#00FFFF";
  $couleur{'rouge'} = "#FF0000";
  $couleur{'mauve'} = "#FF00FF";
  $couleur{'jaune'} = "#FFFF00";
  $couleur{'blanc'} = "#FFFFFF";
}
# Fin initialisation des couleurs ##############################################

#******************************************************************************#
# Fin des fonctions ***********************************************************#
#******************************************************************************#