Un serveur WEB en OpenScheme
Scripts CGI
Par :
Guilhem de Wailly (gdw@erian-concept.com)

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 ajouter au serveur la capacité de traiter les scripts CGI. Nous avons déjà rencontré ces scripts, coté client.
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 scripts CGI sont des programmes indépendants du serveur WEB qui permettent de générer du code HTML ou des images en réponse à une requête. La très grande souplesse de ces scripts provient de leur indépendance de tout langage de programmation, pourvu qu'ils répondent au protocole de communication extrêmement simple imposé par le serveur et le protocole CGI.
L'échanges des informations entre le serveur et le script est effectué au travers du port de connexion et des variables d'environnement. Le serveur WEB doit dont positionner les variables d'environnement correctement, ajuster la ligne de commande et invoquer le script. Si le protocole entre le client et le serveur est supérieur à HTTP/0.9, le serveur doit envoyer ses entêtes avant la réponse du script. Si le nom du script commence par nph- (non print header), le serveur ne doit pas afficher ses entêtes ; ceci est utiliser par certain scripts pour diminuer (très légèrement) le temps de réponse du serveur. Le script envoie sa réponse sur son fichier de sortie standard. Le serveur capture la réponse du script et la retourne comme sa propre globale. 
Réalisation
Pour réaliser la prise en compte de scripts CGI, nous allons modifier le code existant et ajouter un certain nombre de fonction. Dans ce qui suit, le texte en route est ajouté au code existant, le symbole ... symbolise le reste du code existant. Le code entièrement ajouté est écrit en noir.
Modification de la classe <server>
La réalisation commence par ajouter deux champs à la classe du serveur :
(define-class <server> #f
 [name            :initform ""]
 [address         :initform ""]
 [port            :initform 0]
 [root-directory  :initform ""]
  ; Chemin préfixe des scripts 
  [script-alias    :initform '()]
  ; Extensions suffixe des scripts 
 [script-suffix   :initform '()]
 [default-indexes :initform '()]
 [browse          :initform #f]
 [access-log      :initform #f]
 [error-log       :initform #f]
 [error           :initform #f])
Le champ script-alias permet de définir le répertoire virtuel dans lequel seront placés les scripts par un synonyme relatif au répertoire racine du serveur. Le champ pourra être initialisé par une paire de deux chaînes de caractères comme par exemple  '("/cgi-bin" "../les-scripts").
Le champ script-suffix est la liste des extensions autorisées pour les scripts ; elle pourra être définie par '(".cgi" ".bat" ".sh") par exemple.
On modifiera donc l'instanciation de la classe du serveur pour initialiser correctement ces deux nouveaux champs :
; Programme principal.
(let ([server 
       (build
        <server>
       :name            "www.dummy.com"
       :address         "1.1.1.1"
       :port            8080
       :root-directory  "/home/html"
       :script-alias    '("/cgi-bin" ".")
       :script-suffix   '(".cgi"
                           ".sh"
                           ".osm"
                           ".cgi")
       :default-indexes '("index.html"
                           "index.htm"
                           "index.cgi")
       :browse          #t
       :access-log      "ows.log"
       :error-log       "ows.err")])
  (let ([socket (net:socket:make-server (<server>:port server))]
        [accept #f])
   ...
Traitement des requêtes
La fonction qui lit les requêtes ne subit pas de modifications. Par contre, la fonction de traitement des requêtes doit maintenant être capable de détecter que la requêtes concernant un script CGI et effectuer les vérifications nécessaires :
; Traitement des requêtes.
(define (process-query server query)
 (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 des scripts CGI
 (let ([url   (<query>:url query)]
       [alias (<server>:script-alias server)])
   ; S'il y a un alias...
   (if (pair? alias)
    ; et que c'est le préfixe de la ressource
    ; demandée...
    (if (string-head? url (car alias))
    (let ([path (if (pair? (cdr alias))
                    (cadr alias)
                    "/")])
      ; on vérifie que l'extension est
      ; un suffixe valide
      (let loop ([suffix (<server>:script-suffix
                          server)])
      (cond [(null? suffix)
             (print-error server
                          query
                          403
                          "Forbidden"
                          "Access prohibited "
                          url)]
            [(not (string-tail? url (car suffix)))
             (loop (cdr suffix))]))
     ; C'est bien un script CGI !
     (<query>:cgi! query #t)
     
     ; On remplace le préfixe par l'alias.
     (<query>:url! query
                  (path!
                   path
                   (substring url
                              (string-length
                               (car alias))
                             (string-length url))))

     ; Un petit message d'aide à la mise au point...
     (format *current-error-port*
             "~a: URL is the CGI ~a\n"
             (uptime)
             (<query>:url query))
     ))))

  ; La suite n'a pas changée.
  (let ([url (<query>:url query)])
   (if (os:directory? (path! (<server>:root-directory server)
                               url))
  ...
La fonction détecte si la ressource demandée est préfixée par le préfixe des scripts CGI. Si c'est le cas, il s'agit d'un script. Elle vérifie alors que le suffixe du scripts est bien un suffixe autorisé. Si c'est le cas, la fonction remplace alors ce préfixe virtuel par le chemin racine du site ajouté à l'alias des scripts CGI. On affiche une information d'aide à la mise au point sur le port de sortie standard.
Nous sommes maintenant prêts à afficher les résultats.
Affichage du résultat
La fonction d'affichage du résultat est modifiée pour tenir compte de la présence des scripts CGI :
; Production des résultats.
(define (output-resource server query)
 (let* ([resource (<query>:resource query)]
    ...
         (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)]
     ; Cas où la ressource demandée est un script CGI.
     [(<query>:cgi query)
     (format *current-error-port* "cgi requested\n")
     (output-cgi server query)]
     [else
     (format *current-error-port* "file requested\n")
     (output-file server query)])))
Si le champ <query>:cgi est vrai, alors la fonction output-cgi est invoquée pour appeler le script CGI après avoir correctement initialisé l'environnement.
Invocation du scripts
Il s'agit de la fonction responsable de l'invocation du script CGI :
; Production du résultat pour les scripts CGI.
(define (output-cgi server query)
(let (; Positionnement d'une variable d'environnement
      [set (lambda (name value)
           (os:setenv name
                      (if (string? value)
                       value
                        (format #f "~a" value))))])
      ; Positionnement d'une variable d'environnement
      ; à partir de la valeur d'un entête.
      [set-header (lambda (name)
                  (let ([couple (assoc
                                 name
                                 (<query>:headers
                                  query))])
                   (if couple
                   (begin
                    (string-replace! name #\- #\_)
                    (set name (cdr couple))))))])

  ; Variables d'environnement standard.
 (set "SERVER_SOFTWARE"   *server*)
 (set "SSERVER_NAME"      (<server>:name server))
 (set "SERVER_ADDRESS"    (<server>:address server))
 (set "GATEWAY_INTERFACE" "CGI/1.1")
 (set "SERVER_PROTOCOL"   (<query>:protocol query))
 (set "SERVER_PORT"        (format
                            #f
                           "~a"
                           (<server>:port server)))
 (set "REQUEST_METHOD"    (<query>:command query))
 (set "REQUEST_URI"       (<query>:uri query))
 (set "DOCUMENT_ROOT"     (<server>:root-directory
                            server))
 
 (set "SCRIPT_NAME"        (<query>:resource query))
 (set "SCRIPT_FILENAME"    (<query>:resource query))
 (set "SCRIPT_FILENAME"    (<query>:resource query))
 (set "QUERY_STRING"      (<query>:string query))

 (set-header "CONTENT-LENGTH")
 (set-header "CONTENT-TYPE")
 (set-header "COOKIE")
 (set-header "HOST")
 (set-header "IF-MODIFIED-SINCE")
 (set-header "REFERER")
 (set-header "USER-AGENT")
  
 ; Si le protocole est supérieur à HTTP/0.9 et
  ; que le nom du programme ne commence pas 
  ; par nph-...
 (if (and (not (string-ci=? (<query>:protocol query)
                            "http/0.9"))
          (not (string-head?
                (string-upcase 
                 (program-name
                  (<query>:resource query)))
                "NPH-")))
   ; afficher les entêtes.
  (print-header query "200 OK"))
 (format *current-error-port*
         "\t~a\n"
         (<query>:resource query))

  ; Si la méthode est POST...
 (if (string-ci=? (<query>:command query) "post")
  (let* ([couple (assoc "CONTENT-LENGTH"
                        (<query>:headers query))]
         [len    (if couple
                   (string->number (cdr couple))
                   0)]
          ; lire les champs sur le port ...
         [str    (port-read len)])
    ; et invoquer le script avec ces valeurs en 
    ; en entrée.
   (with-input-from-string
       str
    (lambda ()
     (ps:system (<query>:resource query)))))
   ; sinon, invoquer le script directement.
  (ps:system (<query>:resource query)))))
La fonction positionne un certain nombre de variables d'environnement requises par le protocole CGI. Si le protocole utilisé est supérieur au protocole HTTP/0.9 et que le nom du programme CGI ne commence pas par nph-, les entêtes standard sont affichés. Rappelons que le port de sortie standard du serveur est à ce stade connecté au client, c'est à dire au navigateur.
Nous invoquons ensuite le programme CGI proprement dit. Là encore, la sortie standard du programme CGI est automatiquement connectée à la sortie standard du serveur par OpenScheme, elle même connectée au navigateur. Si la méthode utilisée est POST, les champs de l'éventuel formulaire doivent être lus après les entêtes ; sinon, dans le cas de la méthode GET, ils sont placés dans l'URL. L'avantage de la méthode POST est qu'il n'y a pas de limite à la taille des données transférées. Si la méthode est POST, il est nécessaire de mettre à disposition les données sur le port d'entrée standard du processus fils créé par la fonction ps:system. Nous aurions pu laisser les choses se faire naturellement considérant que le port d'entrée du serveur est connecté au port d'entrée du processus fils ; cependant, les scripts CGI sont en général mal écrits et comptent sur l'obtention d'une fin de fichier pour interrompre leur lecture des champs au lieu de tenir compte de la variable d'environnement CONTENT_LENGTH. Comme le port d'entrée est reliée à un socket, il n'y a pas de fin de fichier et cela place le processus fils dans une attente infinie. Au lieu de cela, nous lisons les champs explicitement en tenant compte de leur taille et nous associons au port d'entrée du processus fils une zone de mémoire tampon qui, elle, provoquera une fin de fichier.
Notons qu'en première approche, notre serveur n'impose pas de temps maximum d'exécution pour les programmes CGI (timeout). 
L'ajout de la prise en compte des scripts CGI est maintenant terminée. Nous allons examiner les différentes fonctions utilitaires utilisées dans cette réalisation.
Fonction utilitaires
Nom du programme
Cette fonction extrait le nom du programme en supprimant le chemin d'accès. Invoquée avec "/home/html/programme.cgi" en argument, elle retournera "programme.cgi" :
(define (program-name resource)
 (let ([len (string-length resource)])
   (if (zero? len)
       resource
       (let loop ([i (- len 1)])
         (cond [(< i 0)
                resource]
               [(eq? (string-ref resource i) #\/)
                (substring resource (+ i 1) len)]
               [else
                (loop (- i 1))])))))
La fonction est bâtie sur un itération qui recherche en partant de la fin de la chaîne de caractères le séparateur de chemin #\/. Si ce caractère est rencontré, la chaîne qui le suit est extraite et retournée comme résultat.
Remplacement de caractères dans une chaîne
Cette fonction permet de remplacer un caractère par un autre dans une chaîne. Le remplacement peut s'appliquer à tous les caractères possibles ou seulement au premier en partant de la gauche, en fonction d'une option donnée en argument facultatif :
(define (string-replace! string car par . first-only) 
 (let ([len (string-length string)])
   (let loop ([i 0])
     (cond [(= i len)
            string]
           [(eq? (string-ref string i) car)
            (string-set! string i par)
            (if (null? first-only)
                (loop (+ i 1))
                string)]
           [else
            (loop (+ i 1))]))))
Là encore, la fonction est bâtie sur un itération. Lorsque le caractère à remplacé est rencontré, il est remplacé. Si l'option first-only n'est pas définie, l'itération se poursuit alors jusqu'à la fin de la chaîne.
Mise en majuscule
La fonction suivante change tous les caractères de la chaîne de caractères passée en argument pas les majuscules équivalentes :
(define (string-upcase string)
 (list->string
  (map char-upcase
       (string->list string))))
Cette fonction convertie la chaîne de caractères en liste de caractères auxquels elle applique la fonction standard de conversion char-upcase puis elle reconstruit une chaîne de caractères à partir de la liste de caractères convertie. La réalisation de cette fonction pourrait être améliorée pour être moins gourmande en mémoire.
Temps système
Enfin, cette fonction est une aide à la mise au point qui ne fonctionne que sur les systèmes Linux (ça tombe bien !). Elle retourne le temps lié à l'horloge temps réel du système dont la précision est en dessous de la seconde. Elle permet d'obtenir des traces précises :
(define (uptime)
 (with-input-from-file
     "/proc/uptime"
   read))
La fonction se contente de lire le contenu du fichier /proc/uptime et de retourner le résultat qui sera interprété comme un nombre réel.
Exemple
Dans un premier temps, nous allons créer un formulaire utilisant la méthode GET :
<html>
<body>
Entrez votre nom et votre pr&eacute;nom:
<form method=get action=/cgi-bin/test.cgi>
<br>nom          <input type=text name=nom   >
<br>pr&eacute;nom<input type=text name=prenom>
<br><input type=submit>
</form>
</body>
</html>
Avec la méthode GET, les champs sont passés au script CGI dans l'URL du script, séparé de son nom par le caractère #\?.
Voici maintenant le programme CGI test.cgi :
#! ./osm --banner=off --call --cgi

<html>
<br>Le nom saisi est           :
<b><osm(display nom)   osm></b>
<br>Le pr&eacute;nom saisi est :
<b><osm(display prenom)osm></b>
</html>
Il faut remplacer ./osm par le chemin et le nom de votre OpenScheme. Les variables Scheme nom et prenom sont initialisées automatiquement par OpenScheme à la valeur des champs correspondants dans le formulaire HTML.
Lançons le serveur :
$ ./ows.osm
5095.110000: make server socket
5095.140000: accept connection (1)
Sur un autre terminal, connectons-nous avec un navigateur :
$ lynx localhost:8080/test.html
Sur le terminal du serveur, voici les informations de mise au point affichées :
5190.120000: read the request
5190.140000: going to read
5190.150000: end to read
5190.150000: line = "GET /test.html HTTP/1.0"
5190.150000: command = "GET", uri = "/test.html", protocol = "HTTP/1.0"
5190.160000: header = "Host: localhost:8080"
5190.180000: header = "Accept: text/html, text/plain, ..."
5190.280000: header = "Accept-Encoding: gzip, compress"
5190.290000: header = "Accept-Language: en"
5190.290000: header = "User-Agent: Lynx/2.8.2rel.1 libwww-FM/2.14"
5190.300000: header = ""
mime = "text/html"
file requested
5190.310000: shutdown the socket

5190.310000: accept connection (2)
Remplissons le formulaire dans le navigateur, et soumettons-le au serveur. Voici la trace du serveur :
5417.260000: read the request
5417.260000: going to read
5417.270000: end to read
5417.270000: line = "GET /cgi-bin/test.cgi?nom=c%27est+mon+nom&prenom=et+mon+pr%E9nom HTTP/1.0"
5417.270000: command = "GET", uri = "/cgi-bin/test.cgi?nom=c%27est+mon+nom&prenom=et+mon+pr%E9nom", protocol = "HTTP/1.0"
5417.270000: header = "Host: localhost:8080"
5417.290000: header = "Accept: text/html, text/plain, ..."
5417.360000: header = "User-Agent: Lynx/2.8.2rel.1 libwww-FM/2.14"
5417.360000: header = "Referer: http://localhost:8080/test.html"
5417.370000: header = ""
5417.370000: URL is the CGI ./test.cgi
mime = "text/plain"
cgi requested
       /usr/local/home/gdw/erian/doc/html/./test.cgi
5418.240000: shutdown the socket

5418.250000: accept connection (3)
Ces traces facilitent grandement la mise au point du programme.
OpenScheme tient compte automatiquement des méthodes POST et GET pour formater la valeur des champs. En remplaçant GET par POST, on obtient exactement le même fonctionnement.
Le code du serveur OWS mise à jour vous attend sur le site http://www.erian-concept.com/pub/ows.tgz.
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.