Réaliser un serveur de Chat
![Stacks Image 3702](files/stacks-image-41a2507.png)
- nous devons vérifier les connexions des ordinateurs,
- ensuite, il faut accepter l'identifiant (user) et vérifier qu'il soit unique,
- les messages seront traités et renvoyés automatiquement à tous les utilisateurs connectés,
- nous traiterons le cas de la déconnexion d'un utilisateur,
- la déconnexion complète du client,
- et bien sûr le traitement des erreurs.
Analyse d'une séquence
Voici une série de copies d'écran expliquant une séquence de connexion d'un client sur notre serveur de chat.
![Stacks Image 3709](files/stacks-image-6e7afe8-800x180.png)
1 - Connexion du client
![Stacks Image 3805](files/stacks-image-9cd1da8-800x368.png)
2 - Authentification de l'utilisateur
![Stacks Image 3802](files/stacks-image-3c861b1-800x380.png)
3 - Envoi du message
![Stacks Image 3799](files/stacks-image-1e451b2-800x382.png)
4 - Déconnexion de l'utilisateur
![Stacks Image 3814](files/stacks-image-50d0afc-800x380.png)
5 - Déconnexion du client
Le programme
Les programmes ont été réalisés dans un but didactique. J'ai volontairement omis la mise en place de mécanisme de contrôle de l'enchaînement des séquences. Vous pouvez effectuer des opérations non permises comme envoyer des messages sans authentification de l'utilisateur afin de vérifier la gestion d'erreur.
Programme serveur
![Stacks Image 3796](files/stacks-image-1aa7e32.png)
J'indique les procédures situées dans l'handler de la carte pour les boutons
Le programme est relativement simple, tout le code se situe principalement dans le handler de la carte. Les boutons font appel aux procédures chatServerStart et chatServerStop.
local sConnectedClients -- Liste des utilisateurs authorisés [utilisateur] => [nom]
local sPendingClients -- liste des hôtes en attente
local sClientNames -- Nom de l'utilisateur courant
local sRunning -- serveur en cours
constant kPort = 8020
-- Démarre le serveur
command chatServerStart
   if not sRunning then
      put true into sRunning
      put empty into field "LstMessages"
      put empty into field "LstPending"
      put empty into field "LstConnect"
      put "start server" & return before field "LstMessages"
      accept connections on port kPort with message "chatServerClientConnected"
   end if
end chatServerStart
-- Stoppe le serveur
command chatServerStop
   if sRunning then
      put false into sRunning
      put empty into sConnectedClients
      put empty into sPendingClients
      put empty into sClientNames
      put empty into field "LstPending"
      put empty into field "LstConnect"
      repeat for each line tSocket in the opensockets
         close socket tSocket
         put "deconnect socket : " & tSocket & return before field "LstMessages"
      end repeat
      put "stop server" & return before field "LstMessages"
   end if
end chatServerStop
on chatServerClientConnected pSocket
   put pSocket & return after sPendingClients
   put sPendingClients into field "LstPending"
   put "connect client : " & pSocket & return before field "LstMessages"
   read from socket pSocket until return with message "chatServerMessageReceived"
end chatServerClientConnected
on chatServerMessageReceived pSocket, pMsg
   if length(pMsg) > 1 then
      put char 1 to -2 of pMsg into pMsg
      local tAuth, tCommand, tLength, tMsg
      put pSocket is among the keys of sConnectedClients into tAuth
      put item 1 of pMsg into tCommand
      put item 2 of pMsg into tLength
      if tLength is not an integer then
         put "Invalid message length" & return into tMsg
         write "WARN," & the number of chars in tMsg & return & tMsg & return to socket pSocket
      else
         switch tCommand
            case "DCNX"
            -- Déconnexion de l'utilisateur
            if tAuth then
               read from socket pSocket for tLength chars
               if it is among the lines of sClientNames then
                  put "disconnect client : " & it & return before field "LstMessages"
                  write "DCNX,0" & return to socket pSocket
                  chatServerBroadcast it && "disconnected"
                  delete line lineoffset(it, sClientNames) of sClientNames
                  put pSocket & return after sPendingClients
                  put sPendingClients into field "LstPending"
                  put empty into sConnectedClients[pSocket]
                  delete line lineoffset(pSocket, sConnectedClients) of sConnectedClients
                  put empty into field "LstConnect"
                  repeat for each line tSocket in the keys of sConnectedClients
                     put tSocket & "," & sConnectedClients[tSocket] into field "LstConnect"
                  end repeat
               end if
            else
               put "Client not verified" & return into tMsg
               write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
            end if
            break
         case "STOP"
            -- Déconnexion de l'hôte
            if tAuth then
               -- l'utilisateur est connecté, deconnexion automatique
               read from socket pSocket for tLength chars
               if it is among the lines of sClientNames then
                  put "disconnect client : " & it & return before field "LstMessages"
                  delete line lineoffset(pSocket, sConnectedClients) of sConnectedClients
                  write "DCNX,0" & return to socket pSocket
                  chatServerBroadcast it && "disconnected"
                  delete line lineoffset(it, sClientNames) of sClientNames
               end if
               put empty into field "LstConnect"
               repeat for each line tSocket in the keys of sConnectedClients
                  put tSocket & "," & sConnectedClients[tSocket] into field "LstConnect"
               end repeat
            end if
            if pSocket is among the lines of sPendingClients then
               delete line lineoffset(pSocket, sPendingClients) of sPendingClients
            end if
            put "disconnect host : " & pSocket & return before field "LstMessages"
            put sPendingClients into field "LstPending"
            break
         case "MESG"
            -- gestion des messages
            if tAuth then
               read from socket pSocket for tLength chars
               put "message send : " & sConnectedClients[pSocket] & return before field "LstMessages"
               chatServerBroadcast sConnectedClients[pSocket] & ":" && it
            else
               put "Client not verified" & return into tMsg
               write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
             end if
            break
         case "AUTH"
            -- authentification de l'utilisateur
            if tAuth then
               put "Client already verified" & return into tMsg
               write "WARN," & the number of chars in tMsg & return & tMsg to socket pSocket
            else
               read from socket pSocket for tLength chars
               if it is not among the lines of sClientNames then
                  put it into sConnectedClients[pSocket]
                  put "accept client : " & it & return before field "LstMessages"
                  put it & return after sClientNames
                  write "VERI,0" & return to socket pSocket
                  delete line lineoffset(pSocket, sPendingClients) of sPendingClients
                  put sPendingClients into field "LstPending"
                  repeat for each line tSocket in the keys of sConnectedClients
                     put tSocket & "," & sConnectedClients[tSocket] into field "LstConnect"
                  end repeat
                  chatServerBroadcast it && "connected"
               else
                  put "Username already taken" & return into tMsg
                  write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
               end if
            end if
            break
         default
            put "Unknown command" & return into tMsg
            write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
            break
         end switch
      end if
   end if
   read from socket pSocket until return with message "chatServerMessageReceived"
end chatServerMessageReceived
command chatServerBroadcast pMsg
   local tMsg
   put "MESG," & the number of chars in pMsg & return & pMsg & return into tMsg
   repeat for each line tSocket in the keys of sConnectedClients
      write tMsg to socket tSocket
   end repeat
end chatServerBroadcast
on socketClosed pSocket
   if pSocket is among the lines of sPendingClients then
      delete line lineoffset(pSocket, sPendingClients) of sPendingClients
   else if sConnectedClients[pSocket] is not empty then
      local tName
      put sConnectedClients[pSocket] into tName
      delete variable sConnectedClients[pSocket]
      delete line lineoffset(tName, sClientNames) of sClientNames
      chatServerBroadcast tName && "disconnected"
   end if
end socketClosed
Le code principal se trouve dans la procédure chatServerMessageReceived initialisé par la commande read from socket.
local sConnectedClients -- Liste des utilisateurs authorisés [utilisateur] => [nom]
local sPendingClients -- liste des hôtes en attente
local sClientNames -- Nom de l'utilisateur courant
local sRunning -- serveur en cours
constant kPort = 8020
-- Démarre le serveur
command chatServerStart
   if not sRunning then
      put true into sRunning
      put empty into field "LstMessages"
      put empty into field "LstPending"
      put empty into field "LstConnect"
      put "start server" & return before field "LstMessages"
      accept connections on port kPort with message "chatServerClientConnected"
   end if
end chatServerStart
-- Stoppe le serveur
command chatServerStop
   if sRunning then
      put false into sRunning
      put empty into sConnectedClients
      put empty into sPendingClients
      put empty into sClientNames
      put empty into field "LstPending"
      put empty into field "LstConnect"
      repeat for each line tSocket in the opensockets
         close socket tSocket
         put "deconnect socket : " & tSocket & return before field "LstMessages"
      end repeat
      put "stop server" & return before field "LstMessages"
   end if
end chatServerStop
on chatServerClientConnected pSocket
   put pSocket & return after sPendingClients
   put sPendingClients into field "LstPending"
   put "connect client : " & pSocket & return before field "LstMessages"
   read from socket pSocket until return with message "chatServerMessageReceived"
end chatServerClientConnected
on chatServerMessageReceived pSocket, pMsg
   if length(pMsg) > 1 then
      put char 1 to -2 of pMsg into pMsg
      local tAuth, tCommand, tLength, tMsg
      put pSocket is among the keys of sConnectedClients into tAuth
      put item 1 of pMsg into tCommand
      put item 2 of pMsg into tLength
      if tLength is not an integer then
         put "Invalid message length" & return into tMsg
         write "WARN," & the number of chars in tMsg & return & tMsg & return to socket pSocket
      else
         switch tCommand
            case "DCNX"
            -- Déconnexion de l'utilisateur
            if tAuth then
               read from socket pSocket for tLength chars
               if it is among the lines of sClientNames then
                  put "disconnect client : " & it & return before field "LstMessages"
                  write "DCNX,0" & return to socket pSocket
                  chatServerBroadcast it && "disconnected"
                  delete line lineoffset(it, sClientNames) of sClientNames
                  put pSocket & return after sPendingClients
                  put sPendingClients into field "LstPending"
                  put empty into sConnectedClients[pSocket]
                  delete line lineoffset(pSocket, sConnectedClients) of sConnectedClients
                  put empty into field "LstConnect"
                  repeat for each line tSocket in the keys of sConnectedClients
                     put tSocket & "," & sConnectedClients[tSocket] into field "LstConnect"
                  end repeat
               end if
            else
               put "Client not verified" & return into tMsg
               write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
            end if
            break
         case "STOP"
            -- Déconnexion de l'hôte
            if tAuth then
               -- l'utilisateur est connecté, deconnexion automatique
               read from socket pSocket for tLength chars
               if it is among the lines of sClientNames then
                  put "disconnect client : " & it & return before field "LstMessages"
                  delete line lineoffset(pSocket, sConnectedClients) of sConnectedClients
                  write "DCNX,0" & return to socket pSocket
                  chatServerBroadcast it && "disconnected"
                  delete line lineoffset(it, sClientNames) of sClientNames
               end if
               put empty into field "LstConnect"
               repeat for each line tSocket in the keys of sConnectedClients
                  put tSocket & "," & sConnectedClients[tSocket] into field "LstConnect"
               end repeat
            end if
            if pSocket is among the lines of sPendingClients then
               delete line lineoffset(pSocket, sPendingClients) of sPendingClients
            end if
            put "disconnect host : " & pSocket & return before field "LstMessages"
            put sPendingClients into field "LstPending"
            break
         case "MESG"
            -- gestion des messages
            if tAuth then
               read from socket pSocket for tLength chars
               put "message send : " & sConnectedClients[pSocket] & return before field "LstMessages"
               chatServerBroadcast sConnectedClients[pSocket] & ":" && it
            else
               put "Client not verified" & return into tMsg
               write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
             end if
            break
         case "AUTH"
            -- authentification de l'utilisateur
            if tAuth then
               put "Client already verified" & return into tMsg
               write "WARN," & the number of chars in tMsg & return & tMsg to socket pSocket
            else
               read from socket pSocket for tLength chars
               if it is not among the lines of sClientNames then
                  put it into sConnectedClients[pSocket]
                  put "accept client : " & it & return before field "LstMessages"
                  put it & return after sClientNames
                  write "VERI,0" & return to socket pSocket
                  delete line lineoffset(pSocket, sPendingClients) of sPendingClients
                  put sPendingClients into field "LstPending"
                  repeat for each line tSocket in the keys of sConnectedClients
                     put tSocket & "," & sConnectedClients[tSocket] into field "LstConnect"
                  end repeat
                  chatServerBroadcast it && "connected"
               else
                  put "Username already taken" & return into tMsg
                  write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
               end if
            end if
            break
         default
            put "Unknown command" & return into tMsg
            write "ERRO," & the number of chars in tMsg & return & tMsg to socket pSocket
            break
         end switch
      end if
   end if
   read from socket pSocket until return with message "chatServerMessageReceived"
end chatServerMessageReceived
command chatServerBroadcast pMsg
   local tMsg
   put "MESG," & the number of chars in pMsg & return & pMsg & return into tMsg
   repeat for each line tSocket in the keys of sConnectedClients
      write tMsg to socket tSocket
   end repeat
end chatServerBroadcast
on socketClosed pSocket
   if pSocket is among the lines of sPendingClients then
      delete line lineoffset(pSocket, sPendingClients) of sPendingClients
   else if sConnectedClients[pSocket] is not empty then
      local tName
      put sConnectedClients[pSocket] into tName
      delete variable sConnectedClients[pSocket]
      delete line lineoffset(tName, sClientNames) of sClientNames
      chatServerBroadcast tName && "disconnected"
   end if
end socketClosed
Le code principal se trouve dans la procédure chatServerMessageReceived initialisé par la commande read from socket.
Programme client
![Stacks Image 3731](files/stacks-image-c25a1be.png)
J'indique les procédures situées dans l'handler de la carte pour les boutons
Le programme du client est encore plus simple, tout le code se situe principalement dans le handler de la carte.
local sIpServer,sSocket
constant kPort = 8020
Command ConnectServer
   put field "TxtIpServer" into sIpServer
   put empty into field "LstMessages"
   put empty into field "LstLog"
   open socket to sIpServer & ":" & kPort with message "ClientConnect"
end ConnectServer
Command Disconnect
   local tUser,tlengthUser
   put field "TxtUser" into tUser
   put the length of tUser into tlengthUser
   write "STOP," & tlengthUser & return & tuser & return to socket sIpServer & ":" & kPort
   put "Disconnect host" & return before field "LstMessages"
   close socket sSocket
end Disconnect
Command Authentication
   local tUser,tlengthUser
   put field "TxtUser" into tUser
   put the length of tUser into tlengthUser
   if tlengthUser > 0 then
      write "AUTH," & tlengthUser & return & tuser & return to socket sIpServer & ":" & kPort
   else
      put "Error authentication" & return before field "LstMessages"
   end if
end Authentication
Command StopConnect
   local tUser,tlengthUser
   put field "TxtUser" into tUser
   put the length of tUser into tlengthUser
   write "DCNX," & tlengthUser & return & tuser & return to socket sIpServer & ":" & kPort
end StopConnect
Command SendMessage
   local tMessage, tlenghtMessage
   put field "TxtMessage" into tMessage
   put the length of tMessage into tlengthMessage
   write "MESG," & tlengthMessage & return & tMessage & return to socket sIpServer & ":" & kPort
end SendMessage
Command ClientConnect pSocket
   put pSocket into sSocket
   read from socket sSocket until return with message "ClientConnectReceveid"
end ClientConnect
Command ClientConnectReceveid pSocket, pMesg
   local tCommand, tLength
   put item 1 of pMesg into tCommand
   put item 2 of pMesg into tLength
   if tLength is an integer then
      put pMesg & return before field "LstLog"
   else
      put pMesg & return before field "LstMessages"
   end if
   read from socket sSocket until return with message "ClientConnectReceveid"
end ClientConnectReceveid
local sIpServer,sSocket
constant kPort = 8020
Command ConnectServer
   put field "TxtIpServer" into sIpServer
   put empty into field "LstMessages"
   put empty into field "LstLog"
   open socket to sIpServer & ":" & kPort with message "ClientConnect"
end ConnectServer
Command Disconnect
   local tUser,tlengthUser
   put field "TxtUser" into tUser
   put the length of tUser into tlengthUser
   write "STOP," & tlengthUser & return & tuser & return to socket sIpServer & ":" & kPort
   put "Disconnect host" & return before field "LstMessages"
   close socket sSocket
end Disconnect
Command Authentication
   local tUser,tlengthUser
   put field "TxtUser" into tUser
   put the length of tUser into tlengthUser
   if tlengthUser > 0 then
      write "AUTH," & tlengthUser & return & tuser & return to socket sIpServer & ":" & kPort
   else
      put "Error authentication" & return before field "LstMessages"
   end if
end Authentication
Command StopConnect
   local tUser,tlengthUser
   put field "TxtUser" into tUser
   put the length of tUser into tlengthUser
   write "DCNX," & tlengthUser & return & tuser & return to socket sIpServer & ":" & kPort
end StopConnect
Command SendMessage
   local tMessage, tlenghtMessage
   put field "TxtMessage" into tMessage
   put the length of tMessage into tlengthMessage
   write "MESG," & tlengthMessage & return & tMessage & return to socket sIpServer & ":" & kPort
end SendMessage
Command ClientConnect pSocket
   put pSocket into sSocket
   read from socket sSocket until return with message "ClientConnectReceveid"
end ClientConnect
Command ClientConnectReceveid pSocket, pMesg
   local tCommand, tLength
   put item 1 of pMesg into tCommand
   put item 2 of pMesg into tLength
   if tLength is an integer then
      put pMesg & return before field "LstLog"
   else
      put pMesg & return before field "LstMessages"
   end if
   read from socket sSocket until return with message "ClientConnectReceveid"
end ClientConnectReceveid