Réponse d'un serveur à tous les clients

**Super_carotte** · 28/12/2010, 12h24

En fin de compte, je me suis facilité la tache en ouvrant 2 invite de commande.
Une qui écoute et une qui envoi les message.
(je ne suis pas parvenu a faire le tout en un)

Donc voici le résultat:
Servuer: test2.pl:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
	use IO::Select;
	use IO::Socket;
	use Digest::MD5 qw(md5_hex);
	use MIME::Base64;
 
	my $boolStopTransmission = 0;
	my @tabCli;        #repertorie l'ensemble des socket de mes clients
	my $k         = -1;
	my $finalPers = "";
	my $finalMess = "";
	my $md5       = "";
 
	my $mess_rep2;
	my @ready;
	my $flag1 = 0;     #ce flag me ser lors d'un test qui verifie
	                   #si un client n'est pas deja present dans @tabCli
 
	$lsn = new IO::Socket::INET( Listen => 1, LocalPort => 7070 );
	$sel = new IO::Select($lsn);
 
	$tabCli[0] =
	  "JemetUneValeurCarJaiUnForeachQuiNecessiteQueMonTableauNeSoitPasVide";
 
	while ( @ready = $sel->can_read ) {
 
		foreach $fh (@ready) {
 
			if ( $fh == $lsn ) {
				$new = $lsn->accept;
				$sel->add($new);
				print "*** Connexion d'un nouvel utilisateur ***\n";
 
				#print "tabCli0=$tabCli[0]\n";
			}
			else {    # Process socket
 
				foreach (@tabCli)
				{     #pour chaque client répertorié dans le tableau
 
					if ( $_ == $fh )
					{    #s'il est deja present, alors le flag passe a 1
						$flag1 = 1;
					}
				}
				if ( $flag1 == 0 )
				{ #si le flag est egale a 0 alors le client n'existe pas dans le tableau donc je le rajoute
					$k = $k + 1;
					$tabCli[$k] = $fh;
					$mess_rep2 =
"\n\n                !!! Bienvenue sur le chatt IRC du CA-CIB !!!\n\n";
					print $fh $mess_rep2;
				}
 
				$flag1 = 0;
 
				my $rep = <$fh>;
				print $rep;
				$rep = decode_base64($rep);    #dechifrage du code
 
				#$i = $i + 1;
				$res1 = $rep;
 
				( $finalPers, $finalMess, $md5, $boolStopTransmission ) =
				  ( $res1 =~ /(.+) XyX (.+) XyX (.+) XyX (.+)/ )
				  ;                            #parsing du message
 
				my $md5Verif = md5_hex($finalMess);
 
				#Verification (CRC) grace a un MD5
				if ( $md5Verif eq $md5 ) {     #Verification CRC OK
 
					if ( $boolStopTransmission eq "1" ) {
						foreach my $it (@tabCli)
						{    #pour chaque client de @tabCli, j'envoi le message
 
							$mess_rep2 =
"*** $finalPers a interrompu la communication ***\n";
 
							#print "tabCli0=$tabCli[0]\n";
							print $it $mess_rep2;
						}
						print
"\n*** $finalPers a interrompu la communication ***\n";
 
					}
					else {
 
						foreach my $it (@tabCli)
						{    #pour chaque client de @tabCli, j'envoi le message
 
							$mess_rep2 = "$finalPers$finalMess\n";
 
							#print "tabCli0=$tabCli[0]\n";
							print $it $mess_rep2;
						}
						print "\n$finalPers$finalMess\n";
					}
				}
				else {       #Verification CRC KO
					print
"Le message suivant a été altéré lors du transfert sur le reseau:";
 
						if ( $boolStopTransmission eq "1" ) {
							foreach my $it (@tabCli)
							{ #pour chaque client de @tabCli, j'envoi le message
 
								$mess_rep2 =
"*** $finalPers a interrompu la communication ***\n";
 
								#print "tabCli0=$tabCli[0]\n";
								print $it $mess_rep2;
							}
							print
"\n*** $finalPers a interrompu la communication ***\n";
						}
						else {
 
							foreach my $it (@tabCli)
							{ #pour chaque client de @tabCli, j'envoi le message
 
								my $mess_rep2 = "$finalPers$finalMess\n";
 
								#print "tabCli0=$tabCli[0]\n";
								print $it $mess_rep2;
							}
							print "\n$finalPers$finalMess\n";
 
						}
					}
				}
			}
		}

Client d'écoute: chat3.pl:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#Ce code en PERL est un client chatt.
#Pour utiliser ce code, ouvrez l invite de commande, placez vous dans le repertoire
#ou est le fichier et ecrivez la commande:
#"pearl Chat2.pl"
#exemple: "perl D:\Data\Chat2.pl"
#Commande detail:
#D:\BENJAMIN>"d:\Appli portable\Eclipse_3.5.1\Data\ActivePerl-5.12.2.1202-MSWin32-x86-293621\perl\bin\perl.exe" Chat2.pl
 
#!/usr/bin/perl
#use warnings;
use strict;
use IO::Socket;
use IO::Socket qw(:crlf);
use IO::Select;
 
my $sock = IO::Socket::INET->new(    #Connection
	PeerAddr => 'localhost',
	PeerPort => '7070',
	Proto    => 'tcp',
) or die "Failed : $@\n";
 
print "\n*** Connexion en cours...***\n";
print "*** Connexion etablie    ***\n";
 
my $sockets = IO::Select->new($sock);
 
$sock->send(
"ICAgICBYeVggICBYeVggNzIxNWVlOWM3ZDlkYzIyOWQyOTIxYTQwZTg5OWVjNWYgWHlYIDA="
);
printf $sock "\n";
 
forever:
while () {
	foreach my $io ( $sockets->can_read() ) {
 
		chomp( my $msg = <$io> );
		print "$msg\n";
	}
}
 
close($sock);
print "*** Fin de connexion ***\n";

Et client d'ecriture: chat2.pl:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
#Ce code en PERL est un client chatt.
#Pour utiliser ce code, ouvrez l invite de commande, placez vous dans le repertoire
#ou est le fichier et ecrivez la commande:
#"pearl Chat2.pl"
#exemple: "perl D:\Data\Chat2.pl"
#Commande detail:
#D:\BENJAMIN>"d:\Appli portable\Eclipse_3.5.1\Data\ActivePerl-5.12.2.1202-MSWin32-x86-293621\perl\bin\perl.exe" Chat2.pl
 
#!/usr/bin/perl
use threads;
use threads::shared;
#use warnings;
use strict;
use IO::Socket;
use Chat2;
use Digest::MD5 qw(md5_hex);
use MIME::Base64;
 
my $sock = IO::Socket::INET->new(    #Connection
	PeerAddr => '10.146.232.106',
	PeerPort => '7070',
	Proto    => 'tcp',
) or die "Failed : $@\n";
 
 
 
my $finalMess="";
my $md5="";
 
 
 
 
print "\n*** Connexion en cours...***\n";
print "*** Connexion etablie    ***\n";
 
 
my $finalPers = personne();    #Renseigne nom et prenom de l'utilisateur
my $stopvariable = " exit";
#my $stopvariable =
#  finCom();    #Renseigne le message qui indiquera au systeme la fin de la comm
my $boolStopTransmission = 0;
 
while ( $stopvariable ne my $finalMess )
{              #Tant que le message fin de comm n'est pas saisi
 
	( $finalMess, $md5 ) = message();
 
	#if ( $stopvariable eq $finalMess ) {    #Dernier message envoyé+fin de comm
		if ( $finalMess eq " exit" ) {    #Dernier message envoyé+fin de comm
		$boolStopTransmission = 1;
		my $res =
		  ("$finalPers XyX$finalMess XyX $md5 XyX $boolStopTransmission");
		$res = encode_base64( $res, "" );    #chiffrement
		$sock->send("$res");
		printf $sock "\n";
		print "Vous avez interrompu la communication\n";
		exit;
	}
	else {                                   #envoi du message
		$boolStopTransmission = 0;
		my $res =
		  ("$finalPers XyX$finalMess XyX $md5 XyX $boolStopTransmission");
 
		$res = encode_base64( $res, "" );    #chiffrement
		$sock->send("$res");
		printf $sock "\n";
		#my $reponse = <$sock>;
		#print "réponse=$reponse\n";
 
	}
}
 
close($sock);
 
print "*** Fin de connexion ***\n";
 
######################  Mes Sub ####################
 
sub personne {
	my $prenom;
	my $nom;
	print "\nVotre prenom : ";
	$prenom = <STDIN>;
	chop($prenom);
	print "Votre Nom : ";
	$nom = <STDIN>;
	chop($nom);
	my $this = Chat2->constPers( "$nom", "$prenom" );
	my $persTemp = "";
 
	foreach ( keys(%$this) ) {
 
		$persTemp = $persTemp . " $$this{$_}";
	}
	print "\n";
	$persTemp=$persTemp.": ";
	return $persTemp;
}
 
sub message {
	my $finalMess = "";
 
	print "\nMessage : ";
	my $messageTemp = <STDIN>;
	chop($messageTemp);
 
	my ( $this, $md5 ) = Chat2->constMess("$messageTemp");
 
	#$this = substr($this, 1);
	$messageTemp = "";
	foreach ( keys(%$this) ) {
 
		$messageTemp = $messageTemp . " $$this{$_}";
	}
 
	return ( $messageTemp, $md5 );
}
 
sub finCom {
	print "Message de fin de communication: ";
	my $stopvariableTemp = <STDIN>;
	chop($stopvariableTemp);
	$stopvariableTemp = " " . $stopvariableTemp;
	return $stopvariableTemp;
}

Suite client d'ecriture: chat2.pm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
package Chat2;
use strict;
use Digest::MD5 qw(md5_hex);
 
sub constMess {
 
	my ( $classe, $message ) = @_;
	my $md5Temp = "";
 
	my $this = { "Message" => $message, };
 
	foreach ( keys(%$this) ) {
		my $md5Temp = $md5Temp = $md5Temp . " $$this{$_}";
	}
	$md5Temp = substr( $md5Temp, 1 );
 
	my $md5 = md5_hex("$md5Temp");
 
	bless( $this, $classe );
	return ( $this, $md5 );
}
 
sub constPers {
 
	my ( $classe, $nom, $prenom, ) = @_;
	my $this = {
		"nom"    => $nom,
		"prenom" => $prenom,
	};
 
	bless( $this, $classe );
	return $this;
}
 
1;

Et voilou, merci encore a vous pjilou pour votre aide durant toute la réalisation de ce code

.

(je continue de chercher pour la solution "tout-en-un",et vous tiens au courant si je trouve quelque chose)

Cordialement,
Benjamin

**Philou67430** · 28/12/2010, 20h35

Envoyé par Super_carotte

(je continue de chercher pour la solution "tout-en-un",et vous tiens au courant si je trouve quelque chose)

Cordialement,
Benjamin

Pourtant, à partir de l'exemple de fichier "client.pl" de mon message #11, tu devrais avoir tous les éléments en main pour réaliser un source de client unique (pour tous les clients, à condition de mettre en paramètre l'IP du serveur par exemple) qui traite en même temps le clavier et le socket du tchat (avec IO::Select, comme pour le serveur).

**Super_carotte** · 29/12/2010, 09h13

En effet, j'ai vu ta solution mais quand j'essaie de la lancer, coté client, je vous écrit "*** Début de connexion ***" mais après, il ne se passe rien, je ne peux pas écrire de messages.

J'ai essayé de le modifier pour le rendre fonctionnel mais j'ai eu quelques soucis

**Super_carotte** · 29/12/2010, 10h54

Mais avant de me repencher sur le 2en1, pour l'instant, je vais résoudre deux petits problèmes:
1- il y a un chiffrement lors de l'envoi d'un message du client au serveur, mais pas lorsque le serveur renvoi le message a tout les clietns.
Bon, la je devrai y parvenir sans problèmes.
--->Résolu 11H51

2-Et le second problème, lorsqu'un utilisateur tape "exit" pour quitter l'application, ça me fait tout planter

mon serveur tourne en boucle et les clients plantent

Vaut mieux remédier a ce chti problème

---> Pose toujours problème

**Super_carotte** · 29/12/2010, 14h27

Petite question, savez vous si le client envoi un message au serveur lorsqu'il est fermé? Je veux dire, est-ce que le module IO socket enverrai un message au serveur par exemple? car ça serait une raison possible des messages d'erreurs que je reçois.

Merci,
Cordialement,
Benjamn

**Super_carotte** · 29/12/2010, 14h47

Probleme trouvé, lorsque le client ecrit "exit" le serveur reçoit un md5 vide alors que le client envoi bien un MD5.
Je vais planché sur ce probleme.

Petit rectificatif, en fait le code fonctionne bien quand l'utilisateur ecrit exit, mais une fois que la partie coté serveur qui gere le moment ou l'utilisateur a taper "exit", apres cette étape, le serveur se met a boucler avec un md5 vide qui sort de je ne sais ou.

Quelqu'un aurait une idée?
Merci,
Benjamin

**Philou67430** · 29/12/2010, 22h57

La solution a ce problème doit se trouver dans l'exemple server.pl que j'ai donnée (toujours dans le message #11), au moment du test eof du socket client :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
      if (eof($socket)) {
        print "Client $client->{name} has left\n";
        $sockets->remove($socket);
        @clients = grep $_ ne $socket, @clients;
        print { $_->{socket} } "$client->{name} has left$CRLF" foreach @clients
      }

Je t'invite à tester la chose suivante : repars seulement des deux fichiers que j'ai fournis dans ce message et essaye de les faire fonctionner sur ta machine (sur la mienne, ils fonctionnaient au jour de l'édition du message ; je n'ai pas vraiment le temps maintenant de le revérifier, mais s'il ne fonctionnaient pas chez toi, j'essayerai à nouveau). Ensuite, adapte les "étape par étape" au protocole que tu veux implémenter, et essaye à nouveau les clients/serveur à chaque étape.

Tu as normalement tous les éléments en main.

**Super_carotte** · 30/12/2010, 09h40

Bonjour,
Le probleme avec votre code c'est qu'il ne fonctionne pas chez moi.
La seule chose que je change c'est que j'enleve "Am" dans votre client.pl.
Il y a écrit "Am" devant le "peerport".
J'essaie de vous mettre un screen du résultat obtenu une fois le "Am" enlevé:
Donc on voit bbien que le serveur voit le client, mais apres, le client reste bloqué. Il n'a pas la possibilité d'envoyer un message.

Hey!! C'est mon centieme message

**Philou67430** · 30/12/2010, 20h26

Bonjour. OK pour le Am qui est une erreur de copiage du script client.pl. Désolé.

Mais une fois enlevé, le client fonctionne (seul défaut, il ne présente aucun prompt). Avez-vous essayé de taper du texte dans la fenêtre du client ? (je travaille sous Ubuntu jusqu'à lundi, je ne pourrais donc pas tester avec ActivePerl/Win32 avant cette date).

**Super_carotte** · 31/12/2010, 09h18

Sous windows, je n'ai pas la possibilité d'ecrire un message mais si vous me dites que sur ubuntu ça fonctionne, alors je vais cherché d'où pourrai venir l'incompatibilité.

**Philou67430** · 01/01/2011, 00h20

Je ne vois pas d'incompatibilité, puisque le script utilise des concepts d'entrées/sorties tout à fait basiques (STDIN pour la lecture dans la console du client).
Je testerai lundi sur mon poste XP+activeperl

**Super_carotte** · 03/01/2011, 11h22

ça y est, j'ai réussi a faire marcher mon chatt (mais celui qui n'est pas 2en1).
Au moins une solution de fonctionnelle

Je vais maintenant m'attaquer a la solution 2en1.

**Philou67430** · 03/01/2011, 17h19

Il semble effectivement que ActivePerl ne supporte pas le handle *STDIN dans un objet IO::Select.

J'ai fait tous mes essais sur Perl/Cygwin sous Windows XP, ce qui fait que je n'ai pas vu le problème d'incompatibilité. Cependant, IO::Select est sensé supporté tout type de handle (voir le synopsis qui donne d'ailleurs STDIN en exemple). C'est donc une limitation d'ActivePerl (que j'ai peine à comprendre, tant c'est pénalisant).

**Super_carotte** · 04/01/2011, 09h07

haha rien n'est parfait dans notre monde (même perl a ses défauts

)

**Philou67430** · 04/01/2011, 15h46

Perl n'a pas de défaut... seule son implémentation

(et dans ce cas, son implémentation Windows... (aïe... troll en vue...

)

**Super_carotte** · 05/01/2011, 12h01

"et dans ce cas, son implémentation Windows"
!!! RÉVOLUTION !!! haha.

Je m'attendais a ces réactions en ayant lâcher "même perl a ses défauts".
J'imaginai déjà Djibril tentant de me géolocaliser pour me trouver et m'amener a un evennement de mongueur pour me lapider en place publique.

**djibril** · 05/01/2011, 12h55

Envoyé par Super_carotte

"et dans ce cas, son implémentation Windows"
!!! RÉVOLUTION !!! haha.

Je m'attendais a ces réactions en ayant lâcher "même perl a ses défauts".
J'imaginai déjà Djibril tentant de me géolocaliser pour me trouver et m'amener a un evennement de mongueur pour me lapider en place publique.

**Philou67430** · 05/01/2011, 14h47

Que veux-tu rien n'est parfait !

Cependant, il doit exister des méthode de lecture non bloquante de STDIN sur ActiveState. Une recherche rapide sur le net m'avait montré que tu n'étais pas le seul à chercher cette fonction.

L'autre solution, sous Windows, c'est d'utiliser l'implémentation de Cygwin. Elle fonctionne comme celle sous Unix (c'est celle-ci que j'ai testé).
Beaucoup plus compliqué, tu peux aussi tenter d'utiliser select, la fonction du Core.

**Philou67430** · 05/01/2011, 15h18

Au fait, content que ton code serveur fonctionne.
Quand est-il du code client ? Toujours 2 thread ?

**Super_carotte** · 05/01/2011, 16h01

Bin coté serveur ça va bien (juste un petit detail; le serveur n'envoi "***un_tel est sortis du chatt***" que pour le premier utilisateur mais ce n'est pas un probleme bloquant.

Et coté client, j'ai 2 fenetre, une qui affiche les messages envoyé au serveur, et une qui permet au client d'ecrire.
Je te met les codes en dessous si tu es ccurieux de voiire ce que ça donne.

Serveur: test2.pl:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
	use IO::Select;
	use IO::Socket;
	use Digest::MD5 qw(md5_hex);
	use MIME::Base64;
 
	my $boolStopTransmission = 0;	#Permet de savoir quand un client a taper "exit"
	my @tabCli;        #repertorie l'ensemble des socket de mes clients
	my $k         = -1;
	my $finalPers = "";
	my $finalMess = "";
	my $md5       = "";
 
	my $mess_rep2;
	my @ready;
	my $flag1 = 0;     #ce flag me sert lors d'un test qui verifie
	                   #si un client n'est pas deja present dans @tabCli
 
	$lsn = new IO::Socket::INET(
		LocalHost => '10.146.232.100',
		Listen    => 1,
		LocalPort => 7070
	);
	$sel = new IO::Select($lsn);
 
	$tabCli[0] =
	  "JemetUneValeurCarJaiUnForeachQuiNecessiteQueMonTableauNeSoitPasVide";
 
	while ( @ready = $sel->can_read ) {
 
		foreach $fh (@ready) {
 
			if ( $fh == $lsn ) {
				$new = $lsn->accept;
				$sel->add($new);
 
				print "*** Connexion d'un nouvel utilisateur ***\n";	
			}
			else {    # Process socket
 
				foreach (@tabCli)
				{     #pour chaque client répertorié dans le tableau
 
					if ( $_ == $fh )
					{    #s'il est deja present, alors le flag passe a 1
						$flag1 = 1;
					}
				}
				if ( $flag1 == 0 )
				{ #si le flag est egale a 0 alors le client n'existe pas dans le tableau donc je le rajoute
					$k = $k + 1;
					$tabCli[$k] = $fh;
					$mess_rep2 =
"\n\n                !!! Bienvenue sur le chatt IRC du CA-CIB !!!\n\n";
					print $fh $mess_rep2;
				}
 
				$flag1 = 0;
 
				my $rep = <$fh>;
 
				if ( length($rep) != 0 ) {
 
					$rep = decode_base64($rep);    #dechifrage du code
 
					#$i = $i + 1;
					$res1 = $rep;
 
					( $finalPers, $finalMess, $md5, $boolStopTransmission ) =
					  ( $res1 =~ /(.+) XyX (.+) XyX (.+) XyX (.+)/ )
					  ;                            #parsing du message
 
					my $md5Verif = md5_hex($finalMess);
 
 
					#Verification (CRC) grace a un MD5
					if ( $md5Verif eq $md5 ) {     #VERIFICATION CRC OK
 
						if ( $boolStopTransmission eq "1" ) {
 
							foreach my $it (@tabCli) {
 
								if ( $it == $fh ) {
									$it = undef;
								}
							}
 
							foreach my $it (@tabCli)
							{ #pour chaque client de @tabCli, j'envoi le message
								if ( length($it) != 0 ) {
 
									$mess_rep2 =
"*** $finalPers est sorti du Chatt ***\n";
									print $it $mess_rep2;
								}
 
							}
 
							print
"\n*** $finalPers est sorti du Chatt ***\n";
						}
						else {
 
							foreach my $it (@tabCli)
							{ #pour chaque client de @tabCli, j'envoi le message
								if ( length($it) != 0 ) {
 
									$mess_rep2 = "$finalPers$finalMess\n";
 
 
									print $it $mess_rep2;
								}
							}
							print "$finalPers$finalMess\n";
						}
					}
					else {    #VERIFICATION CRC KO
						print
"Le message suivant a été altéré lors du transfert sur le reseau:";
 
						if ( $boolStopTransmission eq "1" ) {
 
							foreach my $it (@tabCli) {
 
								if ( $it == $fh ) {
									$it = undef;
								}
							}
 
							foreach my $it (@tabCli)
							{ #pour chaque client de @tabCli, j'envoi le message
								if ( length($it) != 0 ) {
 
									$mess_rep2 =
"*** $finalPers est sorti du Chatt ***\n";
									print $it $mess_rep2;
								}
							}
 
							print
"\n*** $finalPers est sorti du Chatt ***\n";
 
						}
						else {
 
							foreach my $it (@tabCli)
							{ #pour chaque client de @tabCli, j'envoi le message
 
								my $mess_rep2 = "$finalPers$finalMess\n";
								print $it $mess_rep2;
							}
							print "$finalPers$finalMess\n";
 
						}
					}
				}
			}
		}
	}

Client de lecture: chat3.pl:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#Ce code en PERL est un client chatt.
#Pour utiliser ce code, ouvrez l invite de commande, placez vous dans le repertoire
#ou est le fichier et ecrivez la commande:
#"pearl Chat2.pl"
#exemple: "perl D:\Data\Chat2.pl"
#Commande detail:
#D:\BENJAMIN>"d:\Appli portable\Eclipse_3.5.1\Data\ActivePerl-5.12.2.1202-MSWin32-x86-293621\perl\bin\perl.exe" Chat2.pl
 
#!/usr/bin/perl
#use warnings;
use strict;
use IO::Socket;
use IO::Socket qw(:crlf);
use IO::Select;
 
my $sock = IO::Socket::INET->new(    #Connection
	PeerAddr => '10.146.232.100',
	PeerPort => '7070',
	Proto    => 'tcp',
) or die "Failed : $@\n";
 
print "\n*** Connexion en cours...***\n";
print "*** Connexion etablie    ***\n";
 
my $sockets = IO::Select->new($sock);
 
$sock->send(
"ICAgICBYeVggICBYeVggNzIxNWVlOWM3ZDlkYzIyOWQyOTIxYTQwZTg5OWVjNWYgWHlYIDA="
);
printf $sock "\n";
 
forever:
while () {
	foreach my $io ( $sockets->can_read() ) {
 
		chomp( my $msg = <$io> );
		print "$msg\n";
	}
}
 
close($sock);
print "*** Fin de connexion ***\n";

Client d'ecriture: Chat2.pl:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
#Ce code en PERL est un client chatt.
#Pour utiliser ce code, ouvrez l invite de commande, placez vous dans le repertoire
#ou est le fichier et ecrivez la commande:
#"pearl Chat2.pl"
#exemple: "perl D:\Data\Chat2.pl"
#Commande detail:
#D:\BENJAMIN>"d:\Appli portable\Eclipse_3.5.1\Data\ActivePerl-5.12.2.1202-MSWin32-x86-293621\perl\bin\perl.exe" Chat2.pl
 
#!/usr/bin/perl
use threads;
use threads::shared;
#use warnings;
use strict;
use IO::Socket;
use Chat2;
use Digest::MD5 qw(md5_hex);
use MIME::Base64;
 
my $sock = IO::Socket::INET->new(    #Connection
	PeerAddr => '10.146.232.100',
	PeerPort => '7070',
	Proto    => 'tcp',
) or die "Failed : $@\n";
 
 
 
my $finalMess="";
my $md5="";
 
 
 
 
print "\n*** Connexion en cours...***\n";
print "*** Connexion etablie    ***\n";
 
 
my $finalPers = personne();    #Renseigne nom et prenom de l'utilisateur
my $stopvariable = " exit";
#my $stopvariable =
#  finCom();    #Renseigne le message qui indiquera au systeme la fin de la comm
my $boolStopTransmission = 0;
 
while ( $finalMess ne " exit" )
{              #Tant que le message fin de comm n'est pas saisi
 
	( $finalMess, $md5 ) = message();
 
	#if ( $stopvariable eq $finalMess ) {    #Dernier message envoyé+fin de comm
		if ( $finalMess eq " exit" ) {    #Dernier message envoyé+fin de comm
		$boolStopTransmission = 1;
		my $res =
		  ("$finalPers XyX$finalMess XyX $md5 XyX $boolStopTransmission");
		$res = encode_base64( $res, "" );    #chiffrement
		$sock->send("$res");
		printf $sock "\n";
		print "Vous avez interrompu la communication\n";
		exit;
	}
	else {                                   #envoi du message
		$boolStopTransmission = 0;
		my $res =
		  ("$finalPers XyX$finalMess XyX $md5 XyX $boolStopTransmission");
 
		$res = encode_base64( $res, "" );    #chiffrement
		$sock->send("$res");
		printf $sock "\n";
		#my $reponse = <$sock>;
		#print "réponse=$reponse\n";
 
	}
}
 
close($sock);
 
print "*** Fin de connexion ***\n";
 
######################  Mes Sub ####################
 
sub personne {
	my $prenom;
	my $nom;
	print "\nVotre prenom : ";
	$prenom = <STDIN>;
	chop($prenom);
	print "Votre Nom : ";
	$nom = <STDIN>;
	chop($nom);
	my $this = Chat2->constPers( "$nom", "$prenom" );
	my $persTemp = "";
 
	foreach ( keys(%$this) ) {
 
		$persTemp = $persTemp . " $$this{$_}";
	}
	print "\n";
	$persTemp=$persTemp.": ";
	return $persTemp;
}
 
sub message {
	my $finalMess = "";
 
	print "\nMessage : ";
	my $messageTemp = <STDIN>;
	chop($messageTemp);
 
	my ( $this, $md5 ) = Chat2->constMess("$messageTemp");
 
	#$this = substr($this, 1);
	$messageTemp = "";
	foreach ( keys(%$this) ) {
 
		$messageTemp = $messageTemp . " $$this{$_}";
	}
 
	return ( $messageTemp, $md5 );
}
 
sub finCom {
	print "Message de fin de communication: ";
	my $stopvariableTemp = <STDIN>;
	chop($stopvariableTemp);
	$stopvariableTemp = " " . $stopvariableTemp;
	return $stopvariableTemp;
}

Suite client d'ecriture: Chat2.pm:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
package Chat2;
use strict;
use Digest::MD5 qw(md5_hex);
 
sub constMess {
 
	my ( $classe, $message ) = @_;
	my $md5Temp = "";
 
	my $this = { "Message" => $message, };
 
	foreach ( keys(%$this) ) {
		my $md5Temp = $md5Temp = $md5Temp . " $$this{$_}";
	}
	$md5Temp = substr( $md5Temp, 1 );
 
	my $md5 = md5_hex("$md5Temp");
 
	bless( $this, $classe );
	return ( $this, $md5 );
}
 
sub constPers {
 
	my ( $classe, $nom, $prenom, ) = @_;
	my $this = {
		"nom"    => $nom,
		"prenom" => $prenom,
	};
 
	bless( $this, $classe );
	return $this;
}
 
1;

Voili voilou, et encore merci pour toute l'aide que tu m'as apporté lors de la réalisation de ce chatt

Réponse d'un serveur à tous les clients

Langage Perl

Discussions similaires

Partager

Partager