Не удается прочитать из сокета в perl — возможная взаимоблокировка?

#perl #sockets

#perl #сокеты

Вопрос:

Моя операционная система — Archlinux с perl 5.14.2. Я просто пытаюсь написать небольшую программу для выполнения удаленного командного файла. Программа просто передает исходный файл C на сервер. Сервер вызовет gcc для компиляции кода C и передачи сообщения компилятора. Клиент не может получить сообщение компилятора. У меня есть сообщение на сервере. Есть код:

 #!/usr/bin/perl -w
# oj.pl --- alpha


use warnings;
use strict;
use IO::File;
use IO::Socket;

use  constant MY_TRAN_PORT => 138000;
$| = 1;


my $tmpFileToBeCompiled = IO::File->new ("> tmpFile09090989.c") or die "Can't creat this file";

#if (defined $tmpFileToBeCompiled) {
#    print $tmpFileToBeCompiled "argh";         # just for test!
#}
# $fihi->close;

my $port        = shift || MY_TRAN_PORT;

my $sock_server = IO::Socket::INET->new (Listen         => 20,
                                         LocalPort      => $port,
                                         Timeout        => 60,
                                         Reuse          => 1)
    or die "Can't create listening socket: $!n";

my $tmp = 1;
while ($tmp) {
    next unless my $session = $sock_server->accept;

    my $peer = gethostbyaddr ($session->peeraddr, AF_INET)
        || $session->peerhost;
    warn "Connection from [$peer, $port]n";

    while (<$session>) {
        print $tmpFileToBeCompiled $_;              # if it works, the filehandle should be changed into tmpFile.  just fixed.
        print $session "test!";

    }

    my @lines = `gcc tmpFile09090989.c 2>amp;1`;

    foreach ( @lines) {
        print $session  $_ . "test!!!n";
     #   $session->print;
    }


    print "OK!";
    $tmpFileToBeCompiled->close;

    warn "Connecting finished!n";
    $session->close;
    $tmp --;
}

$sock_server->close;

----------------------------------------end--------------------------------------------------------
-------------------------------------client.pl--------------------------------------------------------
use warnings;
use strict;

use IO::Socket qw(:DEFAULT);
use File::Copy;
use constant MY_TRAN_PORT => 138000;
use IO::File;

my $host = shift || '127.0.0.1';
my $port = shift || MY_TRAN_PORT;

my $socket = IO::Socket::INET->new("$host:$port") or die $@;

my $fh = IO::File->new("a.c", "r");

my $child = fork();
die "Can't fork: $!n" unless defined $child;

# if (!$child) {
#     $SIG{CHLD} = sub { exit 0 };
#     userToHost();
#     print "Run userToHost done!n";

#     $socket->shutdown(1);
#     sleep;
# } else {
#     hostToUser();
#     print "Run hostToUser done! n";

#     warn "Connection closed by foreign hostn";

# }
userToHost();
unless ($child) {
    hostToUser();
    print "Run hostToUser done! n";
    warn "Connection closed by foreign hostn";
    $socket->close;

}

sub userToHost {
    while (<$fh>) {
#    print $_;    # for debug
    print $socket $_;
    }
}

sub hostToUser {
    while (<$socket >) {
    print $_;    
    }
}
# copy ("a.c", $socket) or die "Copy failed: $!";
print "Done!";
  

Комментарии:

1. Почему вы разветвляетесь? Кроме того, гораздо проще просто запустить скрипт bash из inetd, не так ли?

2. Спасибо за ответ! какая взаимоблокировка? Вы имеете в виду сервер (oj.pl ) не удается получить сокет, поскольку он хранится у клиента? еще раз спасибо, @DanielRHicks

3. Спасибо, @themel . Я не использовал разветвление при написании этого, но это не может сработать так, как сейчас. Я пытаюсь использовать потоки для устранения блокировки, но это не работает.

Ответ №1:

  1. Вам не нужно подключать клиент. Вообще. Точно так же, как сказал themel
  2. У вас ошибка в клиентском коде: <$socket > должно быть <$socket>
  3. Вам нужно уведомить сервер о том, что вы записали все данные, и сервер может начать компиляцию. В противном случае сервер застрянет while (<$session>) навсегда. Для достижения этого вы могли бы вызвать shutdown($socket, 1) , что означает, что вы закончили писать. Смотрите perldoc -f shutdown

Окончательный прототип (очень грубый) мог бы выглядеть следующим образом: https://gist.github.com/19b589b8fc8072e3cfff

Комментарии:

1. Ха-ха, Perl такой злой — <$socket > заставляет его пытаться открыть файл с именем «IO::Socket::INET=GLOB(0xb9dd20)» неявно вместо чтения из дескриптора файла. Я знал из stracing, что что-то не так, но этот пробел ускользнул от меня.

Ответ №2:

yko справился с задачей, но позвольте мне просто предположить, что ваша задача будет решена намного проще и более поддерживаемым способом с помощью скрипта оболочки, запускаемого из inetd.

Комментарии:

1. Да. Извините, что взял часть вашего ответа. Я просто пытаюсь обобщить ответы на стороне Perl.

2. @yko: С этим все в порядке!