Всем привет ! Запускаю даемон - но он после первого конекта - просто падает на сервере ! Задача даемона ответить клиенту переменной $mes и оборвать конект ! PHP: #!/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;
Если смысл чисто в отправке строки $mes и закрытии соединения, то попробуй так Code: 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; } }
что-то не получается - вот мой работал только после первого конекта падал все время пишит Peer connected:
Теперь другая проблема ! Code: #- часть кода из даемона 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)); Подскажите пожалуйста почему возникает такая проблема Если просто прописать в даемоне Code: my $data = '<a><con><comanda>start</comanda></con></a>'; my $lic = (XML::Simple->new()->XMLin($data)); то все работает , а если брать данные которые приходят от клиентов то не работает !