Résumé
Dans cet article, nous continuons la programmation d'un serveur WEB élémentaire en Scheme. Nous utilisons l'environnement Open-Scheme disponible librement sur le site www.open-scheme.com. Certaines fonctionnalités utilisées sont des extensions à la norme du langage qui peuvent être assez facilement portées vers d'entres systèmes Scheme.
Le mois dernier, nous avons utilisé les sockets pour réaliser les connexions à la place de l'utilisation des fichiers d'entrées / sorties standard. Cela permet maintenant d'accéder à notre serveur par le réseau.
Ce mois-ci, nous allons étendre le serveur pour qu'il puisse afficher des répertoires et leur contenu. La page WEB sera dans ce cas dynamiquement générée par le serveur en fonction du contenu du répertoire. Le type MIME, lorsqu'il est reconnu, sera affiché, ainsi que la taille du fichier et la date de dernière modification.
L'environnement Open-Scheme est amélioré en fonction de ce projet. Aussi, il est nécessaire de se procurer la version la plus récente. Nous faisons notre maximum pour fournir l'environnement en temps et en heure, et librement, sur le serveur WEB d'OpenScheme (www.open-scheme.com) ou sur le CDROM de Linux Magagine. La version light suffit.
Description
Il arrive souvent de tomber sur des serveurs WEB dont le contenu s'affiche comme une liste de fichiers. Les pages HTML correspondantes ne sont pas écrites à l'avance (sauf cas particulier) mais plutôt générées par le serveur en fonction du contenu du répertoire auquel on accède. En fait la règle est assez simple : s'il n'existe pas de fichier d'index (index.html, index.htm ou index.cgi) et que l'on a le droit de lire les entrées du répertoire, alors le serveur génère la liste des fichiers. L'intérêt est que chaque entrée est assortie d'un lien hyper-texte permettant d'accéder à la ressource ; par exemple si l'entrée est un répertoire, le lien hyper-texte permet de rentrer dans ce répertoire.
Nous allons modifier le serveur WEB décrit précédemment dans ces lignes pour qu'il puisse accéder aux répertoires.
Voici ci-dessous un exemple de pages générées par le serveur sur un répertoire. On constate que les entrées du répertoire sont des liens hyper-texte. Certaines entrées sont assorties d'un type déduit de l'extension du nom de la ressource :
Figure
1: Affichage d'un répertoire ; la page est générée
par le serveur. Pour chaque entrée du répertoire, on
affiche son type MIME s'il est connu, la taille du fichier et la
date de dernière modification. Notez que le serveur
fonctionne déjà avec Netscape Nagigator. Le port 8080
a été choisi lors de la création de l'objet
serveur.
Pour réaliser cela, le serveur doit détecter que la ressource est un répertoire, que ce répertoire ne contient aucun index par défaut, et que l'utilisateur possède le droit de lire le contenu du répertoire.
Production de la page HTML
Voici en premier lieu la fonction responsable de l'affichage de la page WEB en fonction d'une requête correspondante à un répertoire :
; Production de la page HTML
pour un répertoire.
; Query est la requête qui
contient la ressource demandée.
; La ressource est la
totalité d répertoire, depuis la racine.
(define
(output-tree server query)
(let* ([start (string-length
(<server>:root-directory
server))]
;
Nom publique de la ressource (suppression
;
de la racine du serveur).
[public (substring
(<query>:resource query)
start
(string-length
(<query>:resource query)))])
;
Entête de la page.
(display
"<html><body>")
;
Affichage du nom du répertoire affiché.
(display "<table width=100% cols=1 border=0>\n")
(display "<tr bgcolor=#aaaaaa><td
align=center>")
(format #t
"<b>~a</b></td></tr>\n" public)
(display "</table>")
;
Affichage de la table à 4 colones.
(display
"<table width=100% cols=4 border=0>\n")
;
Titres des colones.
(display "<tr
bgcolor=#aaaaaa>")
(display " <th
width=1>Resource </th>\n")
(display "
<th width=1>Type </th>\n")
(display " <th width=1>Size </th>\n")
(display " <th>Modification
date</th></tr>\n")
;
Si le répertoire n'est pas la racine du serveur
;
affichage du répertoire .. permettant de remonter
;
dans le répertoire parent.
(if (not
(eqv? public "/"))
(begin
(format #t
"<tr><td><a
href=~a><b>. .</b></a></td>"
(let ([name (os:dirname public)])
(if (eqv? name "/.")
"/"
name)))
(display
"<td> </td><td> </td><td> </td>\n")))
;
Parcourt des entrées du répertoire.
(os:rundir (<query>:resource query)
#f
; pas de sélection de fichier
#f ;
pas de récursion dans les sous-répertoires
#t ; donner les répertoires
(lambda (name)
(let* (; Nom
publique de la ressource.
[resource
(substring name
start
(string-length
name))]
;
Recherche dans la liste des types MIME
;
d'un type correspondant à
l'extension
;
du fichier.
[mime (assoc
(os:extname resource)
*mimes*)]
;
S'il existe un type, la description
;
est en troisième position.
[desc (if (and mime
(> (length mime) 2))
(caddr mime)
#f)])
;
Lien hyper-texte.
(format #t
"<tr><td><a href=~s>"
resource)
;
Nom, en gras si c'est un répertoire.
(format #t
(if
(os:directory? name)
"<b>~a/</b>"
"~a")
(os:basename
resource))
(display "</a></td>\n")
;
Description MIME, si elle existe.
(format
#t
"<td>~a</td>\n"
(if desc desc
" "))
;
Taille de la ressource.
(format #t
"<td>~a</td>\n" (os:size name))
;
Date de dernière modification.
(format #t
"<td> ~a</td>\n"
(date->string (os:modified name)))
;
Fin de la ligne du tableau.
(display
"</tr>\n"))))
;
Fin du tableau et fin de la page HTML.
(display
"</table></body></html>\n")))
Cette fonction sera invoquée avec une ressource dont on est certain qu'elle correspond à un répertoire et que ce répertoire possède les droits de visite par le serveur.
Elle affiche le nom de la ressource demandée dans une table. Puis les entrées du répertoire sont affichées une à une dans un tableau à quatre colonnes, avec le nom de l'entrée, son type MIME s'il est connu, la taille de la ressource et la date de dernière modification. L'affichage est rendu agréable en utilisant quelques enjoliveurs HTML.
Types MIME
Le format des types MIME a été légèrement modifié depuis sa première présentation, pour prendre en compte la description du type. Chaque entrée de la liste des types est une liste à deux ou trois champs, le premier étant le nom de l'extension du fichier, le second, le type MIME correspondant, ou faux, et le troisième, la description, ou faux ou rien. On a principalement :
(define *mimes*
'(("htm" "text/html" "Page WEB")
("html" "text/html" "Page WEB")
("txt" "text/plain" "Texte")
("css" "text/css" "Style HTML")
("gif" "image/gif" "Image GIF")
("jpg" "image/jpeg" "Image JPEG")
("jpeg" "image/jpeg" "Image JPEG")
("tif" "image/tiff" "Image TIF")
("tiff" "image/tiff" "Image TIFF")
("png" "image/png" "Image PNG")
("tgz" #f "Archive")
("osm" "text/html"
"OpenScheme source")
("scm"
"text/html" "Scheme source")
("c" "text/html" "C source")
("h" "text/html" "C header")
("tgz" #f "Archive")
("gz" #f "Archive")
))
Les descriptions des types ne doivent pas contenir d'espaces pour être affichées sur une seule ligne dans le tableau. On remplacera donc les espaces par l'espace insécable HTML noté (attention au point-virgule). Nous avons volontairement réduit la liste des types possibles. Dans le cas d'une liste très longue, on pourra placer les types dans une table de hachage (OpenScheme possède de manière native une bibliothèque pour la gestion des tables de hachage).
Au fait, Christiane, MIME, ça veut dire Multi Purpose Internet Mail Extension :) (Dictionnaire: http://www.iiris.fr/pages/Vocab.htm).
Attention, le format des types MIME du serveur a changé, aussi, nous devons prendre en compte cette modification dans le code existant. La fonction à modifier est output-resource, au début. Cette fonction doit aussi être modifié pour prendre en compte l'affichage des répertoires.
Prise en compte des répertoires
La prise en compte des répertoire se fait au moment de l'analyse de la ressource demandée, dans la fonction output-resource. Cette fonction avait été présentée initialement, mais simplifiée. Voici donc la nouvelle version :
; Traitement des
requêtes
(define (output-resource server query)
(let* ([resource (<query>:resource query)]
[protocol (<query>:protocol query)]
[path?
(path? resource)]
[ext (if path? #f
(os:extname resource))]
[mime (if path?
#f (assoc ext *mimes*))]
[mime (if mime
(cadr mime) #f)]
[mime (if mime mime "text/plain")])
(format *current-error-port* "mime = ~s\n"
mime)
; si le protocole est supérieur
à 0.9, produire
; les entêtes
(if (and (or (string=? protocol
"HTTP/1.0")
(string=? protocol
"HTTP/1.1")
(string=? protocol
"HTTP/1.2"))
(string=? mime
"text/plain")
(string=? mime
"text/html"))
(begin
(print-header query "200 OK")
(format
#t "Content-Length: ~a\r\n" (os:size resource))
(format #t "Last-Modified: ~a\r\n\r"
(format-date (os:modified resource)))
(format #t "Content-Type: ~a\r\n\r\n" mime)))
(cond [(string-ci=? (<query>:command query)
"head")
(format *current-error-port*
"header requested\n")
'nothing]
[path?
(format
*current-error-port* "tree requested\n")
(output-tree server query)]
[else
(format *current-error-port* "file requested\n")
(output-file server query)])))
La prise en compte des répertoires est simplement effectuée lorsque la ressource demandée est un répertoire. Pour l'instant, le serveur ne gère pas les droits d'accès aux ressources. Nous ajouterons cela ultérieurement.
Traitement des requêtes
La dernière fonction à modifier est celle qui traite les requêtes en amont. Elle doit maintenant s'assurer, lorsque la ressource demandée est un répertoire, qu'il n'existe pas d'index par défaut :
(define (process-query
server query)
; vérification que le répertoire
racine existe
(if (not (os:directory?
(<server>:root-directory
server)))
(print-error server
query
404
"Not found"
"No such file or directory: "
(<server>:root-directory server)))
; Vérification qu'un répertoire est terminé
par /.
(let
([url (<query>:url query)])
(if
(os:directory?
(path! (<server>:root-directory
server)
url))
(if
(not
(path? url))
(<query>:url! query
(string-append
(<query>:url
query)
"/")))))
; Si l'URL est un répertoire, vérifier si un index
; par défaut n'existe pas.
(let
([url (<query>:url query)])
(if
(path? url)
(let
loop ([indexes (<server>:default-indexes
server)])
(if
(not
(null?
indexes))
(let*
([nurl (string-append
url
(car
indexes))]
[path (path!
(<server>:root-directory
server)
nurl)])
(if
(os:exists?
path)
(<query>:url! query nurl)
(loop (cdr
indexes))))))))
; Fabrication du nom de la
ressource
(<query>:resource! query
(path! (<server>:root-directory server)
(<query>:url query)))
; Vérification
des droits d'accès
(check-access server query)
; Obtention de la ressource
(let ([err (trap
(output-resource server query))])
(if err
(format *current-error-port*
"***
Error ~a\n"
err))))
Les ajouts en rouges permettent de s'assurer que le nom d'un répertoire est bien terminé par le caractère / et le cas échéant, de l'ajouter. Puis la fonction vérifie aussi que, dans le répertoire demandé, il n'existe pas d'index par défaut. S'il en existe un, il est rajouté à la ressource. Le reste à déjà été expliqué précédemment.
Avec ces ajouts et modifications, notre serveur est maintenant capable de naviguer dans le système de fichier du serveur WEB.
L'auteur
Guilhem de Wailly, directeur de la société Erian Concept : support, formations, configurations, administration, développements Linux. Environnement Open-Scheme.
http://www.erian-concept.com
Références
WEB
 TCP/IP, Architecture,
protocoles, applications
Douglas Comer
InterEdition
ï‚· W3C
http://www.w3c.org
ï‚· CGI
http://www.jmarshall.com/easy/cgi/
ï‚· CGI
http://hoohoo.ncsa.uiuc.edu/cgi/
ï‚· CGI
http://www.tsden.org/ryutaroh/fileupload-e.shtml
ï‚· CGI en Français
http://www.scripts-fr.com/
ï‚· CGI+Scheme
http://www.lh.com/~oleg/ftp/Scheme/web.html
ï‚· FastCGI
http://www.fastcgi.com/
ï‚· HTTP en
Français
http://webbo.enst-bretagne.fr/ActiveWebFr/eg-uk-tut.book_29.fr.html
ï‚· HTTP 1.0
http://www.ietf.org/rfc/rfc1945.txt
ï‚· HTTP 1.1
http://www.ietf.org/rfc/rfc2616.txt
Scheme
 Structure et Interprétation
des programmes informatiques
H. Abelson, GJ.
Sussman
InterEdition
 The Scheme Programming
Languages - Ansi Scheme
R. Kent Dybvig
Prentice Hall
 Les langages Lisps -
Christian Queinnec
InterEdition
 Programmer avec Scheme
- J. Chazarin
Thomson Publishing
 Revised4 Report on the
Algorithmic Language Scheme
W. Clinger, J.
Rees
ftp://ftp.nj.nec.com/pub/kelsey
Environnements Scheme Free
 Bigloo -
Manuel Serrano
http://kaolin.unice.fr
Environnement
de programmation Scheme.
 DrScheme -
Rice University
http://www.cs.rice.edu/CS/PLT/
Environnement
Scheme libre très avancé.
 PCScheme - Texas
Instrument
ftp://cui.unige.ch/public/pcs/pcscheme.exe
Un
très bon environnement de programmation Scheme pour DOS, avec
éditeur intégré.
 Scm - A.
Jaffer
http://www-swiss.ai.mit.edu/~jaffer
La
référence des interprètes Scheme. Très
petit, rapide, pour beaucoup de plates-formes, extensible.
 Stk -
Erik Gallesio
http://kaolin.unice.fr
Interprète
Scheme avec la bibliothèque TK.
D'autres liens sont visibles sur le site www.schemers.org.
Environnements Scheme commerciaux
 ChezScheme -
Cadence, Inc
http://www.scheme.com/
Environnement
Scheme très performant.
 EdScheme, 3Dscheme -
Scheme, Inc
http://www.schemers.com/
Environnement
de programmation Scheme pour Windows.
 Inlab Scheme - Inlab
Software GmbH
http://www.munich.net/inlab/scheme/
Environnement
commercial
 Open-Scheme -
Erian Concept
http://www.open-scheme.com
Environnement
professionnel de programmation Scheme comprenant un interprète,
un compilateur et un débogueur symbolique.
Existe en
version libre et commerciale, pour Linux, FreeBSD, Solaris, Windows
et BeOS, sur systèmes Intel et Sun.