Un serveur en Common Lisp.
Philippe Brochard - hocwp@free.fr
Dans cet article, je vous propose de réaliser un petit serveur en Common Lisp [1] et [2]. Il aura pour but de simuler un serveur IRC "Internet Relay Chat" minimal avec une seule pièce.
Un serveur IRC est simplement un programme qui ouvre des connexions sur un port de l'ordinateur et qui transmet les messages des clients connectés à tous les autres clients. Dans cette version minimale, le serveur répondra aux commandes suivantes :
Et dans un deuxième temps :
Toutes les autres phrases, qui ne sont pas interprétées, sont envoyées à tous les clients connectés au serveur. Pour pouvoir nous connecter sur le serveur avec un « vrai » client IRC, il faudrait que nous respections les commandes IRC standards [3] et [4]. Ici, nous utiliserons simplement . Le protocole de communication entre les clients et le serveur étant suffisamment simple pour que l'on se concentre sur le code.
Pour réaliser ce serveur, nous allons avoir besoin d'ouvrir un port sur la machine et d'attendre des connexions sur ce port. Pour cela, nous devons résoudre une petite difficulté. Comme nous l'avons vu dans le précédent article, le Common Lisp est un langage standardisé par l'ANSI. Malheureusement, au moment de cette standardisation, les fonctions pour gérer le réseau n'étaient pas aussi avancées. Il n'y a donc pas de méthode standard (au sens de l'ANSI) pour ouvrir une connexion. Donc chaque implémentation a créé ses propres fonctions. Nous avons donc deux choix : soit nous nous bornons à une implémentation, soit nous profitons des macros et nous faisons en sorte d'appeler les fonctions de chaque implémentation avec une syntaxe unifiée. Je vous propose d'utiliser cette dernière méthode grâce au module net.lisp du CLOCC [6] (the Common Lisp Open Code Collection). Vous trouverez une version de ce code sur le CDRom du magazine.
Rentrons dans le vif du sujet. Tout d'abord, nous chargeons le module net.lisp et nous définissons deux variables globales. est une liste contenant toutes les connexions ouvertes avec les clients. Et contiendra la socket du serveur.
(load "net.lisp") (defvar *all-clients* '()) (defvar *sock* nil)
Ensuite nous définissons la fonction principale permettant de créer le serveur.
(defun start-server (port)
(setq *sock* (port:open-socket-server port))
(format t "Démarrage du serveur sur le port ~A~%" port)
(loop
(let ((new-sock (port:socket-accept *sock* :wait 0.01d0)))
(when new-sock
(new-connexion new-sock)))
(dolist (client *all-clients*)
(when (listen client)
(read-command client)))))
Nous stockons dans la socket du serveur. Puis nous lançons la boucle principale. Nous attendons, pendant 0,01 seconde, une nouvelle connexion d'un client. Cette connexion est stockée dans la variable locale . Si cette variable n'est pas nulle, alors il y a un nouveau client, nous appelons alors la fonction .
Ensuite, nous parcourons la liste de toutes les connexions des clients et nous regardons, grâce à la fonction , si un client a quelque chose à dire. Dans ce cas, nous lisons son message avec la fonction .
(defun new-connexion (new-sock) (push new-sock *all-clients*) (format t "Nouvelle connexion: ~A~%" *all-clients*) (send-to-client new-sock "Bienvenue! Les commandes sont /quit /close /info Tout le reste est envoyé aux autres clients.~%") (send-to-all new-sock " ==> Nouveau client sur le channel~%"))
Lorsqu'un nouveau client se connecte, nous l'insérons dans la liste . Et nous lui envoyons un message de bienvenue et nous informons les autres clients de cette connexion.
(defun read-command (client)
(let ((str (string-trim (coerce '(#\Return) 'string)
(read-from-client client))))
(cond ((string-equal str "") nil)
((string-equal str "/quit") (client-quit client))
((string-equal str "/close") (close-and-quit))
((string-equal str "/info") (info-on-server client))
(t (send-to-all client "~A~%" str)))))
Tout d'abord, nous lisons la ligne envoyée par le client grâce à la fonction . Nous enlevons le retour chariot en fin de ligne si nécessaire avec la fonction . Et nous stockons le résultat dans la variable locale . Ensuite, nous comparons la ligne tapée par le client aux commandes possibles du serveur. Si aucune commande n'est trouvée la dernière directive de la condition est évaluée et nous envoyons donc la chaîne de caractères à tous les clients. Ceci est réalisé grâce aux fonctions et
(defun read-from-client (client)
(let ((ret nil))
(when (nth-value 1 (ignore-errors
(setq ret (read-line client))))
(client-quit client))
ret))
La fonction est en fait la fonction que l'on a protégé par un dont on teste la deuxième valeur pour savoir si le client est toujours connecté. Dans le cas où une erreur est survenue, cette deuxième valeur est vraie, nous considérons, dans ce cas, que le client n'est plus connecté au serveur. Nous fermons donc proprement sa connexion avec la fonction . Si aucune erreur ne s'est produite pendant la lecture, la deuxième valeur vaut NIL. Nous aurions pu protéger la fonction de manière plus fine avec la macro et réagir différemment suivant le type d'erreur lors de la lecture des données sur la socket.
(defun send-to-client (client control-string &rest args)
(when (nth-value 1 (ignore-errors
(apply #'format client control-string args)))
(client-quit client)))
La fonction prend en argument la connexion du client, une chaîne de formatage et le reste des arguments que l'on veut envoyer au client. Elle se comportera donc comme la fonction mais elle sera protégée par un dans le cas où le client est déconnecté.
La fonction applique à la fonction les arguments (qui décrit le flux où envoyer le message), (qui est une chaîne qui décrit comment afficher le message, elle est la même que pour la fonction format) et tous les autres arguments (qui correspondent à ce que l'on veut envoyer au client). Nous protégeons le serveur des erreurs qui pourraient survenir si la connexion au client n'est plus valide grâce à la fonction et nous considérons que le client a quitté le serveur dans le cas où une erreur est survenue. Nous le faisons alors quitter proprement le serveur grâce à la fonction .
La fonction consiste juste à afficher le message sur l'écran du serveur et sur l'écran de tous les clients connectés à l'exception du client qui envoie le message.
(defun send-to-all (client control-string &rest args)
(apply #'send-to-client t control-string args)
(dolist (cl *all-clients*)
(unless (eq client cl)
(apply #'send-to-client cl control-string args))))
Dans la fonction , nous envoyons un message à tous les clients pour prévenir qu'un client s'est déconnecté. Puis nous fermons la socket du client et nous l'enlevons de la liste des clients connectés.
(defun client-quit (client) (send-to-all client " <== Un client a quitté le serveur~%") (close client) (setq *all-clients* (remove client *all-clients*)))
Ensuite, en réponse à la commande , nous définissons la fonction qui permet d'arrêter le serveur à distance. Nous fermons toutes les connexions des clients, ainsi que la socket du serveur et nous quittons le programme.
(defun close-and-quit ()
(format t "Fin de connexion~%")
(dolist (client *all-clients*)
(close client))
(port:socket-server-close *sock*)
(quit))
Bien évidement, tout le monde peut fermer le serveur, ce qui, dans une utilisation courante, est assez gênant et attirera sûrement les petits plaisantins. Nous verrons, dans la version un peu plus complète, comment protéger cette commande par un mot de passe.
Enfin, pour finir, nous fournissons la fonction qui permet de savoir combien de clients sont connectés : c'est-à-dire, la taille de la liste des connexions.
(defun info-on-server (client)
(send-to-client client "Il y a ~A clients connectés au serveur~%"
(length *all-clients*))
(send-to-client client "sockets = ~A~%" *all-clients*))
Nous n'avons plus qu'à lancer le serveur avec la fonction
(start-server 25555)
Et voilà, en une soixantaine de lignes, vous avez un serveur multi-plateforme résistant aux déconnexions !
Pour tester le fonctionnement du programme, vous pouvez stocker toutes les lignes précédentes dans le fichier et vous pouvez lancer le serveur avec, suivant votre implémentation :
lisp -load server-list.lisp cmucl -load server-list.lisp clisp server-list.lisp sbcl --load server-list.lisp
Comme client, le plus simple est d'utiliser sur le port 25555.
Voici un exemple d'une session sous emacs. La fenêtre du haut est un shell dans lequel on lance le programme, et les deux fenêtres du bas sont des connexions au serveur via telnet.
Dans ce paragraphe, je vous propose d'améliorer le serveur. Pour cela, nous ferons en sorte de gérer les noms des clients et les mots de passe pour fermer le serveur. Nous en profiterons pour nettoyer le code et utiliser moins de variables globales.
(load "net.lisp") (defvar *all-clients* (make-hash-table :test #'equal)) (defvar *password* "plop")
Tout d'abord, comme dans le code précédent, nous chargeons le module net.lisp pour se servir des fonctions du réseau de manière unifiée.
Ensuite nous définissons la variable . Cette fois, nous voulons gérer les noms des clients, nous utilisons donc une table de hashage pour stocker les connexions des clients ainsi que leurs noms. La clé de la table sera la socket ouverte par le client, la valeur sera son nom. Bien évidement, si vous décidez d'étendre le serveur, au lieu de stocker le nom sous forme d'une chaîne de caractères, vous pouvez utiliser une structure plus complète pour stocker d'autres informations sur le client (comme ses points de vie dans le cas d'un MUD (Multi User Dungeon)).
Dans le code précédent, nous avons utilisé une liste comme moyen pour stocker les connexions et la fonction pour parcourir l'ensemble des connexions. Nous utilisons, maintenant, une table de hashage. Pour avoir le minimum de modifications à faire sur le code existant, ce serait bien d'avoir un moyen de parcourir toute la table de hashage avec une fonction de la même forme que la fonction . Appelons la . Malheureusement, cette fonction n'existe pas sous cette forme par défaut dans la norme du Common Lisp. Soit nous devons utiliser la macro , ou la macro , ou la fonction . Aucune de ces trois méthodes ne ressemble à la fonction .
Qu'à cela ne tienne, créons, grâce aux macros, notre propre macro avec la même syntaxe que la fonction !
Pour cela, la fonction semble être une bonne candidate. Elle fonctionne de la manière suivante (le test peut être fait directement depuis la ligne de commande du Lisp) :
CL-USER> (defvar hash (make-hash-table :test #'equal))
HASH
CL-USER> (setf (gethash "toto" hash) 100)
100
CL-USER> (setf (gethash "plop" hash) 500)
500
CL-USER> (setf (gethash "klm" hash) 250)
250
CL-USER> (maphash #'(lambda (key val)
(format t "key=~A val=~A~%" key val))
hash)
key=klm val=250
key=plop val=500
key=toto val=100
Nous devons donc définir une macro qui produit le code suivant :
(do-hash (clé valeur hash)
... le corps de la macro utilisant clé et valeur ...)
devient
(maphash #'(lambda (clé valeur)
... le corps de la macro utilisant clé et valeur ...)
hash)
La macro permettant de faire ceci est la suivante :
(defmacro do-hash ((key val hash) &body body)
`(maphash #'(lambda (,key ,val)
,@body)
,hash))
Une remarque : les variables key et val, quand elles sont évaluées, capturent les noms des variables passées en argument de la macro. Ainsi nous pouvons utiliser les noms associés à key et val dans le corps de la macro. Testons cette macro :
CL-USER> (do-hash (clé valeur hash)
(format t "clé=~A valeur=~A~%" clé valeur))
clé=klm valeur=250
clé=plop valeur=500
clé=toto valeur=100
CL-USER> (macroexpand-1 '(do-hash (clé valeur hash)
(format t "clé=~A valeur=~A~%" clé valeur)))
(maphash #'(lambda (clé valeur)
(format t "clé=~a valeur=~a~%" clé valeur))
hash)
Tout fonctionne correctement. Pour plus de détails sur la confection de macros, je vous laisse vous reporter aux excellents livres de Paul Graham [7] ou Peter Norvig [8] et en particulier OnLisp [9].
Comme nous allons utiliser des commandes plus complexes qui prendront des arguments, nous aurons besoin de découper une chaîne de caractères et de la convertir en une liste. Ceci peut être fait avec la fonction suivante, grâce à la macro :
(defun split-string (string &optional (separator #\Space))
(loop for i = 0 then (1+ j)
as j = (position separator string :start i)
collect (subseq string i j) while j))
On parcourt la chaîne de caractères de séparateur en séparateur et on collecte, dans une liste, la sous-chaîne de caractères entre la position précédente du séparateur et la nouvelle.
La nouvelle fonction tient maintenant compte du fait que l'on utilise une table de hashage. Donc partout où nous avions un , nous le remplaçons par un avec le paramètre en plus. Aussi, nous évitons d'utiliser la variable globale et la remplaçons par une variable locale.
Nous ajoutons un système permettant de sortir de la boucle proprement et de n'importe quel endroit du programme grâce à l'opérateur spécial . Et nous protégeons la boucle principale par un afin d'être sûr de fermer la socket du serveur quoi qu'il arrive dans la boucle principale.
(defun start-server (port)
(let ((sock (port:open-socket-server port)))
(format t "Démarrage du serveur sur le port ~A~%" port)
(format t "Le mot de passe est : ~A~%" *password*)
(unwind-protect
(catch 'quit
(loop
(let ((new-sock (port:socket-accept sock :wait 0.01d0)))
(when new-sock
(new-connexion new-sock)))
(do-hash (client name *all-clients*)
(when (listen client)
(read-command client name)))))
(port:socket-server-close sock))))
La fonction utilise maintenant la table de hashage stockée dans la variable .
(defun new-connexion (new-sock) (setf (gethash new-sock *all-clients*) "Noname") (format t "Nouvelle connexion: ~A~%" *all-clients*) (send-to-client new-sock "Bienvenue! Les commandes sont : /quit /close /info /name <votre nom> /password <ancien mot de passe> <nouveau mot de passe> Tout le reste est envoyé aux autres clients. S'il vous plaît, choisissez un nom avec la commande /name~%") (send-to-all new-sock "[Server] ==> Nouveau client sur le channel~%"))
Nous faisons ensuite en sorte que la fonction tienne compte du fait que certaines commandes prennent des arguments. Comme par exemple et .
Nous convertissons la première chaîne de caractères de la commande en un symbole afin d'utiliser un , qui, en interne, compare des pointeurs sur un symbole plutôt que de parcourir toutes les chaînes de caractères à longueur de temps. Ce qui est, à priori, plus rapide.
(defun read-command (client name)
(let* ((str (string-trim (coerce '(#\Return) 'string)
(read-from-client client)))
(cmd (split-string str)))
(case (intern (string-upcase (first cmd)))
(|| nil)
(|/QUIT| (client-quit client name))
(|/CLOSE| (close-and-quit client name (second cmd)))
(|/INFO| (info-on-server client))
(|/NAME| (set-client-name client (second cmd)))
(|/PASSWORD| (set-password client (second cmd) (third cmd)))
(t (send-to-all client "[~A] ~A~%" name str)))))
La fonction ne change pas. Et la fonction passe le nom associé au client qui vient de quitter le serveur à la fonction .
(defun read-from-client (client)
(let ((ret nil))
(when (nth-value 1 (ignore-errors
(setq ret (read-line client))))
(client-quit client))
ret))
(defun send-to-client (client control-string &rest args)
(when (nth-value 1 (ignore-errors
(apply #'format client control-string args)))
(client-quit client (gethash client *all-clients*))))
La fonction ne change pas beaucoup, elle tient juste compte du fait que l'on utilise une table de hashage et le nom du client.
(defun send-to-all (client control-string &rest args)
(apply #'send-to-client t control-string args)
(do-hash (cl na *all-clients*)
(unless (eq client cl)
(apply #'send-to-client cl control-string args))))
La fonction , quant à elle, tient compte du fait que l'on utilise un mot de passe : tant que le mot de passe n'est pas correct, nous ne fermons pas le serveur.
De plus, nous utilisons l'opérateur spécial pour rendre la main et sortir proprement de la boucle principale.
(defun close-and-quit (client name password)
(if (string-equal password *password*)
(progn
(send-to-all client "[Server] ~A ferme le serveur~%" name)
(do-hash (cl na *all-clients*)
(close cl))
(format t "Fin de connexion~%")
(throw 'quit nil))
(progn
(format t "Mauvais mot de passe~%")
(send-to-client client "Désolé, mauvais mot de passe~%"))))
La fonction tient compte du nom associé à un client et du fait que l'on utilise une table de hashage :
(defun client-quit (client name) (send-to-all client "[serveur] <== ~A a quitté le serveur~%" name) (close client) (remhash client *all-clients*))
De même pour la fonction .
(defun info-on-server (client)
(send-to-client client "Il y a ~A clients connectés au serveur~%"
(hash-table-size *all-clients*))
(send-to-client client "sockets = ~A~%" *all-clients*))
Nous définissons ensuite deux fonctions permettant de changer le nom du client et le mot de passe. Le mot de passe ne pouvant être changé que si on fournit l'ancien.
(defun set-client-name (client name)
(let ((last-name (gethash client *all-clients*)))
(setf (gethash client *all-clients*) name)
(send-to-client client "[Server] Votre nom est maintenant ~A~%" name)
(send-to-all client "[Server] ~A est maintenant connu sous le nom de ~A~%"
last-name name)))
(defun set-password (client last-password new-password)
(if (string-equal last-password *password*)
(progn
(setf *password* new-password)
(send-to-client client "Nouveau mot de passe !~%")
(format t "Le nouveau mot de passe est : ~A~%" *password*))
(progn
(format t "Mauvais mot de passe~%")
(send-to-client client "Désolé, mauvais mot de passe~%"))))
Puis, nous lançons le serveur.
(start-server 25555)
De la même manière que précédemment, nous testons le serveur grâce à avec Slime et Emacs. La fenêtre dans le coin gauche en haut correspond au serveur lancé depuis Slime. Les autres fenêtres étant les connexions des clients via telnet.
Voila, j'espère que ce petit serveur vous aura donné des idées. Par exemple pour créer un MUD ou un petit serveur web (à condition de respecter le protocole http [5]). Vous trouverez les sources complètes de ce serveur sur le CDRom du magazine.
Amusez-vous bien...
Références :
[1] http://www.lispworks.com/documentation/HyperSpec/Front/index.htm
[2] http://www-2.cs.cmu.edu/Groups/AI/html/cltl/cltl2.html
[3] http://www.faqs.org/rfcs/rfc1459.html
[4] http://www.salemioche.com/irc/
[5] http://www.faqs.org/rfcs/rfc2068.html
[6] http://clocc.sourceforge.net/
Livres :
[7] http://www.paulgraham.com/
[8] http://www.norvig.com/
Livres en ligne :
[9] http://www.paulgraham.com/onlisp.html
[10] http://www.gigamonkeys.com/book/
[11] http://www.algo.be/clr.html
Autres références :
[12] http://www.lisp.org/
[13] http://www.cliki.net/
[14] http://common-lisp.net/
[15] http://clisp.cons.org/
[16] http://www.cons.org/cmucl/