Форум АНТИЧАТ

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)
-   PHP, PERL, MySQL, JavaScript (https://forum.antichat.xyz/forumdisplay.php?f=37)
-   -   помогите подправить демон на perl'e (https://forum.antichat.xyz/showthread.php?t=121389)

malik555 19.05.2009 18:13

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


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

Задача даемона ответить клиенту переменной $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;


Kaimi 19.05.2009 18:33

Если смысл чисто в отправке строки $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 19.05.2009 18:48

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

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

Kaimi 19.05.2009 19:57

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

demond 20.05.2009 15:16

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

malik555 09.06.2009 11:11

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

Код:


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

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 10.06.2009 14:48

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


Время: 13:30