Scheme 26

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.

Cette étude sera le prétexte pour mieux comprendre par la pratique comment fonctionnent les serveurs WEB.

Le mois dernier, nous avons ajouté au serveur la possibilité d'afficher le contenu de répertoire sous la forme de listes de fichiers.

Ce mois-ci, nous allons nous attacher à mettre en place un contrôle d'accès simple par mot de passe. Ce contrôle d'accès permettra de protéger un répertoire contre les accès anonymes et à obliger les utilisateurs à s'authentifier. Nous ajouterons aussi le programme permettant de créer un fichier d'authentification.

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'Open-Scheme (www.open-scheme.com) ou sur le CDROM de Linux Magagine. La version light suffit.

Description

Les informations échangées entre le serveur WEB et le client sont en général composées d'entêtes et d'un corps. Les entêtes sont des informations diverses comme la taille du corps, la date d'expiration, etc. Les entêtes sont séparés entre eux par un saut de ligne et ils sont séparés du corps par une ligne blanche. Attention cependant, la fin de ligne est marquée par deux caractères dont le code en C est '/r' (carriage return) et '/n' (new line). Sous Unix, la fin de ligne est '/n' et sous Windows/DOS elle est '/r/n'.

Lorsqu'un serveur WEB retourne dans les entêtes la chaîne de caractère :

WWW-Authenticate: Basic realm="Ressource"

Il indique que l'accès au groupe de ressources dénommé ``Ressource'' nécessite une authentification de type basique. Lorsque le navigateur identifie cet entête, il affiche une demande d'authentification par mot de passe du type :

Figure 1 : demande d'authentification avec Netscape Navigator.

Dès que l'utilisateur a entré un identifiant et un mot de masse, le navigateur envoie à nouveau la même requête en ajoutant l'entête :

Authorization: Basic dXNlcjpwYXNz

Cet entête indique au serveur WEB que l'utilisateur s'est authentifié. Son nom de connexion et son mot de passe sont accolés et séparés par le caractère ':', le tout étant codé en base64 (codage qui permet de transformer n'importe quelle information binaire sous la forme d'une chaîne de caractères alphanumériques). Dans l'exemple d'authentification ci-dessus, le nom de connexion est 'user' et le mot de passe est 'pass'. Vérifions avec Open-Scheme la nature du codage :

Osm> (net:base64:decode "dXNlcjpwYXNz")

=> "user:pass"

Le serveur doit dès lors utiliser le moyen qu'il souhaite pour vérifier que l'utilisateur 'user' ayant pour mot de passe 'pass' à bien le droit d'accéder à la ressource demandée. Pour cela, il peut consulter une base de donnée ou un fichier particulier. Le serveur WEB Apache permet d'effectuer les authentifications avec des fichiers texte codés.

Notre serveur reprend un peu le même mécanisme en le simplifiant : lorsque le répertoire de la ressource demandée contient un fichier nommé .htaccess, l'authentification est nécessaire. Attention, l'accès aux sous répertoires est autorisé s'ils ne contiennent pas eux-mêmes de fichier .htacess. Nous amméliorerons plus tard notre mécanisme de manière à protéger avec un seul fichier .htaccess tous les sous-répertoires du répertoire protégé.

Attention, nous devrons modifier le serveur de manière à ce que la lecture directe du fichier .htaccess soit interdite ainsi que son affichage dans la liste des fichiers d'un répertoire.

Vérification des accès

La fonction chargée du contrôle des accès a déjà été présentée dans un précédent article. Aussi, nous la modifions pour quelle tienne compte de la nouvelle protection d'accès :

(define (check-access server query)
(let* ([resource (<query>:resource query)]
[url (<query>:url query)]
[path? (path? resource)]
[path (if path?
                    resource
                     (os:dirname resource))])
(if path?
(if (not (<server>:browse server))
(print-error server
query
403
"Forbidden"
"Access prohibited "
url))
(begin
   (if (not (os:file? resource))
(print-error server
query
404
"Not found"
"File not found "
url))
   (if (and
           (<query>:cgi query)
   (not (os:executable? resource)))
(print-error server
query
403
"Forbidden"
"Document not executable "
url))))
(if (not (os:readable? resource))
(print-error server
query
403
"Forbidden"
"Access prohibited "
(<query>:url query)))
; Si la ressource accédée est .htacess
; lui-même le serveur retourne une erreur
(if (eqv? (os:basename resource)
              ".htaccess")
(print-error server
query
404
"Not found"
"File not found "
(<query>:url query)))
(let ([org (getcwd)])
(chdir path)
(let ([where (getcwd)])
(chdir org)
(if (not (string-head?
               where
               (<server>:root-directory
                server)))
(print-error server
query
404
"Not found" "File not found "
(<query>:url query)))))
; Si le fichier .htaccess existe
; dans le répertoire
; de la ressource, on
; effectue un contrôle
(if (os:file? (string-append path ".htaccess"))
; La vérification est effectué par la
; fonction authentificated? décrite plus bas
(if (not (authentificated?
               server
query
(string-append path ".htaccess")))
(begin
; Si l'authentification est nécessaire,
; on affiche un message explicatif après
; l'entête de demande d'authentification
(print-header
        query
        "401 Authorization required")
(format #t
              "Date: ~a\r\n\r"
              (format-date (date)))
(format #t
              "WWW-Authenticate: Basic realm=~s"
              resource)
       (format #t "\r\n"
(format #t "Content-Type: text/html")
       (format #t "\r\n\r\n")
(format #t "<html><title>")
(format #t "401 Authorisation required")
(format #t "</title>")
(format #t "<body><h1>")
(format #t "401 Authorisation required")
(format #t "</h1></body></html>")

; Attention à interrompre le traitement en
; invoquant la continuation du serveur
((<server>:error server) 0))))))

La fonction qui effectue le contrôle d'accès doit récupérer dans les entêtes celui concernant l'utilisateur et son mot de passe et vérifier qu'il est présent dans le fichier des mots de passe :

(define (authentificated?
         server
         query
         .htaccess)
(let* (; Récupération de l'entête
[a (assoc "AUTHORIZATION"
                    (<query>:headers query))]
[b (if a (str:split (cdr a)) #f)]
[c (if (and b (= 2 (length b))
              (cadr b)
               #f)]
; Décodage base64
[d (if c (net:base64:decode c) #f)]
[e (if d (str:split d #\:))]
; Nom de l'utilisateur
[name (if (pair? e) (car e) #f)]
[f (if (and (pair? e)
                       (pair? (cdr e)))
(cadr e)
#f)]
; Cryptage du mot de passe
; (voir plus bas pour la clef)
[g (if f
                (net:crypt "open-scheme server"
                          f)
               #f)]
[pass (if g (net:base64:encode g) #f)]
; Ouverture du fichier des mots de passe
[ok (with-input-from-file
.htaccess
(lambda ()
; Lire toutes les lignes ...
(let loop ([line (read-line)])
(if (eof-object? line)
#f
; Séparer les champs ...
(let ([list (str:split line #\:)])
(if (and (= (length list) 2)
(eqv? name (car list))
(eqv? pass (cadr list)))
    ; Si identiques,
    ; utilisateur authentifié.
#t
   ; sinon, continuer ...
(loop (read-line))))))))])
(if (not ok)
; ajout d'une trace de l'échec
; d'authentification.
(with-append-to-file
(<server>:error-log server)
(lambda ()
(format #t
"[~a]: user ~a not authentificated\n"
(format-date (<query>:date query))
name))))
; On retourne le résultat de l'authentification.
ok))

Le fichier des mots de passes contient sur chaque ligne, le nom de l'utilisateur séparé du mot de passe crypté et encodé base64 par le caractère ':' (attention, seul le mot de passe est encodé, le nom de l'utilisateur apparaissant en clair). Le mot de passe est crypté par la chaîne de caractère "open-scheme server" de manière à ce qu'il ne soit pas stocké en clair dans le fichier (la prochaine version de l'environnement autorisera des clefs vide de manière à obtenir un cryptage irréversible fonctionnant comme le cryptage des mots de passe Unix).

Dans le cas ou l'utilisateur n'est pas authentifié, un message est ajouté à la trace du système.

Ajout d'utilisateurs

Afin de faciliter l'ajout d'utilisateurs dans les fichiers .htaccess, nous ajoutons le code suivant au programme principal, à la fin du fichier :

; si --user est placé sur la ligne de commande
; on ne lance pas le serveur, mais on créé ou
; on modifie un utilisateur dans le fichier
; .htaccess du répertoire courant.
(if (member "--user" *argv*)
(begin
; Demande le nom de l'utilisateur.
(format #t "user: ")
(port-flush)
(let ([user (read-line)])
(if (not (string? user)) (exit))
; Demande le mot de passe.
(format #t "pass: ")
(port-flush)
(let ([pass (read-line)])
(if (not (string? pass)) (exit))
; Encode et crypte le mot de passe.
(set! pass (net:base64:encode
(net:crypt "open-scheme server"
pass)))
(let ([couples
(if (not (os:file? ".htaccess"))
'()
; Si le fichier .htaccess existe,
; créer la liste des couples
(with-input-from-file
".htaccess"
(lambda ()
(let loop ([line (read-line)])
(if (eof-object? line)
'()
(let ([list (str:split line #\:)])
(if (= (length list) 2)
(cons list
(loop (read-line)))
(loop (read-line)))))))))])
; Si l'utilisateur existe déjà,
(if (assoc user couples)
; modifier son mot de passe,
(set-car! (cdr (assoc user couples))
pass)
; sinon, l'ajouter dans la liste.
(set! couples(cons (list user pass)
couples)))
; (Re)créer le fichier
(with-output-to-file
".htaccess"
(lambda ()
(for-each (lambda (couple)
(format #t
"~a:~a\n"
(car couple)
(cadr couple)))
couples))))))
; Quitter le programme.
(exit)))

Cette fonction demande de manière interactive le nom de l'utilisateur à ajouter ou à modifier et son mot de passe. Si le fichier .htaccess existe, elle construit la liste des couples utilisateurs-mot de passes de ce fichier. Elle ajoute ou modifie l'utilisateur saisi, puis elle reconstruit le fichier des mots de passe.

Camouflage de .htaccess

Les fichiers des mots de passes contiennent des informations importantes. Il est nécessaire d'empêcher que ce fichier soit visible ou consultable. Le fichier ne peut déjà pas être ouvert par la protection ajoutée dans la fonction check-access.

Il est maintenant nécessaire de modifier la fonction responsable de l'affichage des listes de répertoires de manière à ce qu'elle camoufle ces fichiers :

(define (output-tree server query)
(let* ([start (string-length

...

(os:rundir
   (<query>:resource query)
#f
#f
#t
(lambda (name)
(let* ([resource (substring
                     name
    start
(string-length name))]
[mime (assoc (os:extname resource)
*mimes*)]
[desc (if (and mime
(> (length mime) 2))
(caddr mime)
#f)])
     ; si le nom du fichier n'est pas .htaccess
     ; alors on peut l'afficher
(if (not (eqv? (os:basename resource)
                   ".htaccess"))
(begin
(format #t "<tr><td><a href=~s>" resource)
(format #t
(if (os:directory? name)
"<b>~a/</b>"
"~a")
(os:basename resource))
...

La fonction d'affichage du contenu des répertoires utilise la fonction os:rundir qui applique une fonction de rappel à toutes les entrées du répertoire courant. Nous détectons que le nom du fichier est .htaccess, et dans ce cas, nous n'affichons rien.

Correction de bugs

Nous avons modifié la fonction get-line qui lit des lignes entières à partir du port d'entrée standard pour qu'elle absorbe le caractère new-line ('\n') lorsque le caractère carriage-return '\r' est rencontré :

(define (get-line)
(let* ([cr (string-ref "\r" 0)]
[list (let loop ()
(if (not (char-ready?))
'()
(let ([c (read-char)])
(cond [(or (eq? c #\newline)
(eof-object? c))
'()]
[(eq? c cr)
(read-char)
'()]
[else
(cons c (loop))]))))])
(list->string list)))

De plus, il se peut que, lors de l'envoie du mot de passe, le client du serveur WEB interrompe brutalement la connexion. Nous avons modifié la fonction read-request de manière à ce qu'elle retourne la valeur fausse lorsque la lecture est incomplète :

(define (read-request server)
(if (not (char-ready? *current-input-port*
30000))
#f
(let* ([query (build <query>)]
...

Nous tenons compte du fait que la requête puisse valoir faux dans la boucle principale du serveur :

(let ([server (build <server>
...
(let ([query (read-request server)])
(if query
(process-query server query)))
...

Nous voila maintenant parés à authentifier nos accès !

Et la suite, serveur !

Le code du serveur mise à jour et complet est disponible sur le serveur http://www.erian-concept.com/pub/ows.tgz. Nous nous excusons auprès des utilisateurs qui ont eu du mal avec les versions précédentes qui étaient des extraits du code complet et qui comportaient quelques erreurs.

Les prochaines étapes majeures dans l'évolution de notre serveur seront :

 Amélioration de la stratégie du contrôle d'accès en protégeant implicitement les sous répertoires d'un répertoire protégé ;

 Les scripts CGI ;

 Code Scheme embarqué et exécuté par le serveur lui-même ;

 Définition d'hôtes virtuels ;

 Mise en place d'une chaîne de traitement des requêtes, un peu comme dans Apache ;

 Redirection automatique de sites ;

 Compilation du serveur en bytecode ;

 Des threads pour le serveur !

Ces points ne seront pas abordés dans l'ordre.

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.