Les archives de Kermith72
Réaliser un serveur de Chat
- 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.
1 - Connexion du client
2 - Authentification de l'utilisateur
3 - Envoi du message
4 - Déconnexion de l'utilisateur
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
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
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
Les sources
Dernière modification: 30/07/2023