Article complet: (Petit) Clône de client telnet en Haskell

Bonjour,

L'autre nuit, muni de café, j'ai souhaité m'amuser avec Haskell. J'ai alors consulté le chapitre sur le réseau en Haskell de Real World Haskell et... j'ai écrit un (très petit) clône de client telnet... qui fait 41 lignes. Le seul soucis étant que dans toute application de ce genre, on doit partager habilement la lecture des entrées de l'utilisateur, et l'affichage de ce que l'on nous envoie. Ceci mis à part, tout cela fonctionne très bien !

[Suite:]

Regardons à quoi cela ressemble. Petit détail : à chaque tour, je lance la réception de données réseau dans un autre thread, pour ne pas bloquer l'écriture de l'utilisateur.

On importe d'abord les modules nécessaires.
import Control.Concurrent 
import Control.Monad 
import Network.Socket 
import Network.BSD 
import System.Environment 
import System.IO

Ensuite, j'ai écrit quelques fonctions pour rendre la connection, l'envoi etc plus faciles.
 
-- Ouverture d'une connexion TCP cliente 
-- Prend en argument l'host et le port/service (qui est une String également) 
-- Retourne le "Handle" vers le socket en question. 
openConnection :: String -> ServiceName -> IO Handle 
openConnection hostname port = 
  do 
  addrInfos <- getAddrInfo Nothing (Just hostname) (Just port) 
  let serveraddr = head addrInfos 
  sock <- socket (addrFamily serveraddr) Stream defaultProtocol 
  setSocketOption sock KeepAlive 1 
  connect sock (addrAddress serveraddr) 
  h <- socketToHandle sock ReadWriteMode 
  hSetBuffering h (BlockBuffering Nothing) 
  return h 
 
-- Ferme la connexion dont le Handle est donné 
closeConnection :: Handle -> IO () 
closeConnection h = hClose h 
 
-- Envoie la chaîne donnée sur le Handle donné, et ensuite fait un flush sur ce handle, ce qui force l'envoi immédiat et nettoie les états 
sendMsg :: Handle -> String -> IO () 
sendMsg h msg = hPutStrLn h msg >> hFlush h 
 
-- Lis sur le Handle donné une chaîne et la renvoie (dans la monade IO) 
recvMsg :: Handle -> IO String 
recvMsg h = do 
  msg <- hGetContents h  
  return msg 


Voyons maintenant la fonction main.
 
main = do 
  args <- getArgs 
  let (host, port) = (args !! 0, args !! 1) 

On récupère les arguments donnés au programme (s'il n'y en a pas assez, cela fera planter le logiciel -- je ne me suis pas vraiment préoccupé de tous les cas d'erreur, mais ce n'était pas ma priorité ici) via la fonction getArgs, et l'on en récupère l'host et le port donnés.

 
  putStrLn $ "Opening client on " ++ host ++ ":" ++ port ++ "\n" 
  hclient <- openConnection host port 
  putStrLn "Client connected" 

Ca y est, on se connecte, en affichant des messages pour tenir l'utilisateur informé. Si la connection échoue, le programme s'arrêtera avec une erreur -- cf remarque ci-dessus.

Et maintenant, la boucle qui permet de lire depuis le réseau et lire depuis l'utilisateur, etc.
 
  forever $ do 
  getLine >>= sendMsg hclient 
  forkIO $ recvMsg hclient >>= putStrLn 


Ici, on a une sorte de boucle "à la while(true)", dans laquelle on va tour à tour récupérer une entrée de l'utilisateur et l'envoyer au serveur, puis, dans un thread séparé, récupérer ce qu'a envoyé le serveur et l'afficher.
Enfin, on ferme la connection (ce code est inutile tant que l'on a pas de possibilité de sortir du forever... qui devra tôt ou tard se transformer en "until" ou autre).
 
  closeConnection hclient 


Voilà donc le code complet :
 
import Control.Concurrent 
import Control.Monad 
import Network.Socket 
import Network.BSD 
import System.Environment 
import System.IO 
 
openConnection :: String -> ServiceName -> IO Handle 
openConnection hostname port = 
  do 
  addrInfos <- getAddrInfo Nothing (Just hostname) (Just port) 
  let serveraddr = head addrInfos 
  sock <- socket (addrFamily serveraddr) Stream defaultProtocol 
  setSocketOption sock KeepAlive 1 
  connect sock (addrAddress serveraddr) 
  h <- socketToHandle sock ReadWriteMode 
  hSetBuffering h (BlockBuffering Nothing) 
  return h 
 
closeConnection :: Handle -> IO () 
closeConnection h = hClose h 
 
sendMsg :: Handle -> String -> IO () 
sendMsg h msg = hPutStrLn h msg >> hFlush h 
 
recvMsg :: Handle -> IO String 
recvMsg h = do 
  msg <- hGetContents h  
  return msg 
 
main = do 
  args <- getArgs 
  let (host, port) = (args !! 0, args !! 1) 
  putStrLn $ "Opening client on " ++ host ++ ":" ++ port ++ "\n" 
  hclient <- openConnection host port 
  putStrLn "Client connected" 
  forever $ do 
  getLine >>= sendMsg hclient 
  forkIO $ recvMsg hclient >>= putStrLn 
  closeConnection hclient 


Pour compiler (j'ai tout ce code dans un fichier net.hs :
ghc --make -o net net.hs
Puis 2 exemples d'exécution...
$ ./net google.fr 80 
Opening client on google.fr:80 
 
Client connected 
GET / HTTP/1.0 
 
HTTP/1.0 302 Found 
Location: http://www.google.fr/ 
Cache-Control: private 
Content-Type: text/html; charset=UTF-8 
Set-Cookie: PREF=ID=30b094ad566b5532:TM=1251456529:LM=1251456529:S=94IXp5-SGiaYADWc; expires=Sun, 28-Aug-2011 10:48:49 GMT; path=/; domain=.google.com 
Date: Fri, 28 Aug 2009 10:48:49 GMT 
Server: gws 
Content-Length: 218 
 
<HTML><HEAD><meta http-equiv="content-type" content="text/html;charset=utf-8"> 
<TITLE>302 Moved</TITLE></HEAD><BODY> 
<H1>302 Moved</H1> 
The document has moved 
<A HREF="http://www.google.fr/">here</A>. 
</BODY></HTML> 
 
^C 
 

(c'est moi qui ai tapé "GET / HTTP/1.0")
( qui vous dira que la page a été déplacée )

Et enfin, la surprise...
 
$ ./net towel.blinkenlights.nl 23 


Qui, une version simplifiée d'un film très connu, vous permettra de voir, Jedi.

Enjoy !