помогите подправить демон на perl'e

[malik555]

Всем привет !


Запускаю даемон - но он после первого конекта - просто падает на сервере !

Задача даемона ответить клиенту переменной $mes и оборвать конект !


#!/usr/bin/perl use POSIX; use Errno; use IO::Socket; use IO::Select; use Tie::RefHash (); my $DaemonPort = 843; #-- Порт, по которому происходит подключение my $min_login_length = 3; #-- Минимальная длина имени my $shutdown = 0; tie %logins, 'Tie::RefHash'; tie %in_buf, 'Tie::RefHash'; my (%out_buf, $TIME); close STDIN; close STDERR; fork && exit; $|=1; my $server = IO::Socket::INET->new(LocalPort => $DaemonPort, Listen => 10 ) or die "Can't make server socket: $@n"; my $select = IO::Select->new($server); while (! $shutdown) { foreach my $client ($select->can_read(0.1)) { #-- Принимаем информацию от клиентов if($client == $server){ #-- Новый клиент $client = $server->accept(); $client->autoflush(1); $select->add($client); print "da\n"; } else { print "no\n"; $mes = '<?xml version="1.0"?><cross-domain-policy><allow-access-from domain="*" to-ports="*" /></cross-domain-policy>'; $out_buf{$client} .= $mes; } } foreach my $client ($select->can_write(0.1)) { next unless exists $out_buf{$client}; my $rv = $client->send("".$out_buf{$client}.chr(0), 0); unless (defined $rv) { next; } if ($rv == length($out_buf{$client})+1 or Errno::EINPROGRESS == $! or Errno::EWOULDBLOCK ) {#-- Удалим тот кусок данных, что клиент удачно получил substr($out_buf{$client}, 0, $rv) = ''; delete $out_buf{$client} unless length($out_buf{$client}); } else { next; } } }#- shutdown $server->close(); exit;

[Kaimi]

Если смысл чисто в отправке строки $mes и закрытии соединения, то попробуй так

use strict;
use warnings;
use IO::Socket;
$SIG{CHLD} = 'IGNORE';

my $mes = '<?xml version="1.0"?><cross-domain-policy><allow-access-from domain="*" to-ports="*" /></cross-domain-policy>';
my $port = 843;

my $sock = IO::Socket::INET->new(LocalPort => $port, Listen => 10, Proto => 'tcp', Reuse => 1) || die $!;

while (my $conn = $sock->accept)
{
my $child = undef;
die $! unless defined ($child = fork);
if ($child == 0)
{
$sock->close;
print $conn $mes;
$conn->close;
exit 0;
}
else
{
warn "Peer connected: ".$conn->peerhost."\n";
$conn->close;
}
}

[malik555]

что-то не получается - вот мой работал только после первого конекта падал

все время пишит Peer connected:

[Kaimi]

Под win xp (perl v5.8.8) и под fedora (perl v5.8.8) у меня все работает. Так что хрен знает

[demond]

так может дело в клиенте? пример кода можно?

[malik555]

Теперь другая проблема !



#- часть кода из даемона

my $data = '';
my $rv = $client->recv($data, POSIX::BUFSIZ, 0); #Читаем данные

#- данные я отправляю в xml например строку
#-<a><con><comanda>start</comanda></con></a>

#- данные приходят все нормально только я пытаюсь #-эту строку разбить на хэш но даемон сразу
#-останавливается

my $lic = (XML::Simple->new()->XMLin($data));



Подскажите пожалуйста почему возникает такая проблема


Если просто прописать в даемоне


my $data = '<a><con><comanda>start</comanda></con></a>';
my $lic = (XML::Simple->new()->XMLin($data));


то все работает , а если брать данные которые приходят от клиентов то не работает !

[malik555]

Может кто знает как решить такую проблему !