Message de socket bloque jusqu'à ce que le thread se termine en Perl

Question

J'essaye d'écrire le code de Perl qui fait la communication bidirectionnelle sur un socket Unix. Il doit faire les choses suivantes: Code

1. client envoie une requête sur la prise
2. code lit la requête
3. Server effectue toutes les actions qui devrait se produire immédiatement
4. Server crée un nouveau thread à faire des actions supplémentaires qui peuvent prendre beaucoup de temps
5. Server envoie une réponse sur la prise
6. le client reçoit une réponse
7. Le nouveau thread continue à fonctionner après que la réponse a été envoyée

J'ai obtenu la plupart de ceci pour fonctionner maintenant, mais avec un problème. Les étapes 1 à 5 fonctionnent correctement, mais à l'étape 6, le client est incapable de lire la réponse tant que le thread n'est pas passé. (même si la réponse a été envoyée plus ou moins immédiatement) Une idée de ce que je fais mal? J'utilise Perl 5.10.1 sur Lucid Ubuntu.

Voici un exemple:

Code client:

#!/usr/bin/perl 
use strict; 
use Socket; 

my $socket_name = 'catsock'; 
my $client_message = "Hello server, this is the client."; 

my $SOCK; 
socket($SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; 
connect($SOCK, sockaddr_un($socket_name)) or die "connect: $!"; 

$| = 1, select $_ for select $SOCK; # turn on autoflush 
print $SOCK $client_message; # send the message 
shutdown($SOCK,1); # finished writing 
print "sent:  $client_message\n"; 

my $server_message = do { local $/; <$SOCK> }; # get the response 
print "recieved: $server_message\n\n"; 

Code Serveur

#!/usr/bin/perl 
use strict; 
use Socket; 
use threads; 
use threads::shared; 

sub threadfunc 
{ 
    print " waiting 5 seconds in new thread...\n"; 
    sleep(5); 
    print " exiting thread...\n\n"; 
} 

my $server_message = "Hello client, this is the server."; 
my $socket_name = 'catsock'; 

my $SERVER; 
my $CLIENT; 
socket($SERVER, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; 
unlink($socket_name); 
bind($SERVER, sockaddr_un($socket_name)) or die "bind: $!"; 
chmod(0660, $socket_name); 
listen($SERVER, SOMAXCONN) or die "listen: $!"; 

print "server started on $socket_name\n\n"; 

while(1) { 
    accept($CLIENT, $SERVER); 

    my $client_message = do { local $/; <$CLIENT> }; # grab entire message 
    print "recieved: $client_message\n"; 

    print "creating new thread...\n"; 
    my $thr = threads->create(\&threadfunc); 
    $thr->detach(); 

    print $CLIENT $server_message; # send the response 
    print "sent: $server_message\n\n"; 

    close $CLIENT; 
} 

Quand je lance cela, les choses suivantes se produisent:

1. Le client envoie "Bonjour serveur, c'est le client."
2. Server reçoit le message du client
3. Server crée un nouveau thread
4. Server envoie "Bonjour client, c'est le serveur."
5. Le client doit recevoir le message maintenant, mais ce n'est pas le cas.
6. fil Nouveau sur le serveur dort pendant 5 secondes
7. des sorties de discussion
8. Maintenant le client reçoit le message du serveur, même si il a été envoyé il y a 5 secondes. Pourquoi?

Answer 1

my $server_message = do { local $/; <$SOCK> } 

dans le script client une drôle d'odeur pour moi. En définissant $/ sur undef, vous demandez à l'instruction <$SOCK> de lire toutes les entrées de la poignée $SOCK jusqu'à la fin du fichier. Dans ce contexte, la fin du fichier signifie que l'autre extrémité du socket a fermé la connexion.

Le serveur délivre le message, comme vous pouvez le voir si vous modifiez la ligne ci-dessus pour quelque chose comme

print "Received message: "; 
print while $_ = getc($SOCK); 

(ce sera aussi accrocher pendant 5 secondes lorsque le courant d'entrée est épuisée, mais elle met également à moins afficher chaque caractère dans l'entrée entre-temps).

Il est une "caractéristique" qu'une extrémité d'une connexion socket TCP ne peut jamais vraiment savoir si l'autre extrémité de la connexion est encore en vie. Les programmeurs de réseau recourent à d'autres conventions - encoder la longueur du message au début de chaque message, terminer chaque message par un jeton spécial, implémenter des pulsations - pour déterminer la quantité d'entrée pouvant être lue en toute sécurité depuis un socket (vous pouvez également regarder dans la version 4 arguments de select)

pour ce problème, une possibilité est d'appliquer la convention que tous les messages du serveur doivent se terminer par un saut de ligne. Modifier le script de serveur pour dire

print $CLIENT $server_message, "\n"; 

et changer le script client pour dire

my $server_message = do { local $/="\n"; <$SOCK> }; # if you're paranoid about $/ setting 
my $server_message = <$SOCK>;      # if you're not 

et vous obtiendrez des résultats plus proches de ce que vous attendez.