Perl: реализация программирования сокетов (система никогда не возвращается)

Question

Моя цель: реализовать программирование сокетов, чтобы клиент пытался подключиться к серверу, если сервер не установлен на удаленном компьютере, клиент (хост) со своей стороны передает tar-файл на сервер (target) и скрипт perl. Этот скрипт perl распаковывает папку и запускает скрипт (серверный perl-скрипт), теперь проблема заключается в следующем: этот серверный скрипт должен запускаться вечно (несколько клиентов), пока машина не перезагрузится или что-то не произойдет. , поэтому скрипт работает правильно: но поскольку он постоянно работает, элемент управления не возвращается к клиенту, который снова попытается подключиться к серверу (на каком-то предопределенном сокете), поэтому в основном я хочу, чтобы каким-то образом я запускал сервер, но возвращал обратно для моего хоста, который является клиентом в этом случае.

вот код:

my $sourcedir = "$homedir/host_client/test.tar"; 
my $sourcedir2 = "$homedir/host_client/sabkuch.pl"; 
my $remote_path = "/local/home/hanmaghu"; 

# Main subroutines 
my $ssh = Net::OpenSSH->new ($hostmachine, user =>$username, password => $password); 
$ssh->scp_put($sourcedir,$sourcedir2,$remote_path) 
    or die "scp failed \n" . $ssh->error; 
# test() is similar to system() in perl openssh package 
my $rc = $ssh->test('perl sabkuch.pl'); 
# check if test function returned or not -> this is never executed 
if ($rc == 1) { 
    print "test was ok , server established \n"; 
} 
else { 
    print "return from test = $rc \n"; 
} 
exit; 

Другой сценарий, который ссылается на наш серверный скрипт является:

#!/usr/bin/perl 
use strict; 
use warnings;    
system('tar -xvf test.tar'); 
exec('cd utpsm_run_automation && perl utpsm_lts_server.pl'); 
#system('perl utpsm_lts_server.pl'); 
# Tried with system but in both cases it doesn't return, 
# this xxx_server.pl is my server script 
exit; 

Сценарий сервера:

#!/usr/bin/perl 

use strict; 
use warnings; 
use IO::Socket::INET; 

#flush after every write 
$| =1; 

my $socket = new IO::Socket::INET (
    LocalHost => '0.0.0.0', 
    LocalPort => '7783', 
    Proto => 'tcp', 
    Listen => 5, 
    Reuse => 1 
); 
die "cannot create socket $! \n" unless $socket; 
print "server waiting for client on port $socket->LocalPort \n"; 

while (1) 
{ 
    # waiting for new client connection 
    my $client_socket = $socket->accept(); 

    # get info about new connected client 
    my $client_address = $client_socket->peerhost(); 
    my $client_port = $client_socket->peerport(); 
    print "connection from $client_address:$client_port \n"; 

    # read upto 1024 characters from connected client 
    my $data = ""; 
    $client_socket->recv($data,1024); 
    print "rceeived data = $data"; 

    # write response data to the connected client 
    $data = "ok"; 
    $client_socket->send($data); 

    # notify client response is sent 
    shutdown($client_socket,1); 
} 
$socket->close(); 

Пожалуйста, помогите, как выполнить это: с точки зрения дизайна это то, что я хочу, но имея эту проблему во время реализации, могу ли я сделать это несколько другой работа вокруг способ.

Answer 1

Update   Добавлено fork + exec пример, как и просили. Здесь я рекомендую system('cmd &').

---

Короче говоря, ваш 'водитель' sabkuch.pl запускает сервер, используя exec - который никогда не возвращается. От exec

«Exec» функция выполняет системную команду и никогда не возвращает; ...

(Выделено из цитируемой документации.) После того, как exec используется, программа работает в этом процессе заменить по другой программе, см exec wiki. Если этот сервер продолжает работать с exit, у вас его никогда не было, то есть, если нет ошибок. См. Так называемый Perl's exec.

Значит, ваш $ssh->test() будет блокироваться навсегда (ну, пока сервер действительно не выйдет). Вам нужен неблокирующий способ для запуска сервера. Вот некоторые варианты

• Запуск драйвера в фоновом режиме

  my $rc = $ssh->test('perl sabkuch.pl &'); 
  

  Это запускает отдельный подоболочку и нерестится sabkuch.pl в нем, а затем возвращает управление и test может завершиться. sabkuch.pl запускает exec и, таким образом, переходит в другую программу (сервер), чтобы работать неограниченное время. См. Background processes in perlipc. Также см. it in perlfaq8, а также множество хороших ссылок. Обратите внимание, что нет необходимости в perl ..., если sabkuch.pl может быть исполнен.

• Посмотрите, есть ли способ для выполнения команд Net::OpenSSH, чтобы он не блокировался.

• Один из способов «сгореть и забыть» - это fork, а затем exec у ребенка, в то время как родительский выход (в данном случае). Тогда еще нужно рассмотреть. Много (обязательная) информация находится в perlipc. Примеры изобилуют в другом месте, найдите fork и exec. Это не следует воспринимать легко, поскольку ошибки могут привести к странному поведению и невыразимым последствиям. Вот пример.

  #!/usr/bin/perl 
  use strict; 
  use warnings;    
  system('tar -xvf test.tar') == 0 or die "Error with system(...): $!"; 
  
  my $pid = fork; 
  die "Can't fork: $!" if not defined $pid; 
  # Two processes running now. For child $pid is 0, for parent large integer 
  
  if ($pid == 0) { # child, parent won't get into this block 
      exec('cd utpsm_run_automation && perl utpsm_lts_server.pl'); 
      die "exec should've not returned: $!"; 
  } 
  # Can only be parent here since child exec-ed and can't get here. Otherwise, 
  # put parent-only code in else { } and wait for child or handle $SIG{CHLD} 
  exit; 
  

  Обычно беспокойство, когда разветвление является wait для детей. Если мы этого не сделаем, это можно решить с помощью с двойным форсированием или путем обработки SIGCHLD (см., Например, waitpid). Пожалуйста, изучите perlfaq8, связанный выше, Signals in perlipc, документы для всех используемых вызовов и все остальное, на что вы можете положиться. В этом случае родитель должен, во что бы то ни стало, выйти первым, а дочерний процесс затем переопределяется init, и все хорошо. Процесс exec -ed получает то же самое $pid, но так как cd вызовет оболочку (sh -c cd), сервер в конечном итоге будет работать с другим PID.

  С system('command &') нам не нужно беспокоиться о ожидании ребенка.

---

Это связано только с вашей прямой вопрос, а не остальной части показанного кода.

Answer 2

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

, но он по-прежнему не работает, пожалуйста, дайте мне knoe, где в этом код я буду неправильно

#!/usr/bin/perl 

use strict; 
use warnings; 

system('tar -xvf test.tar'); 

my $child_pid = fork; 

if (!defined $child_pid){ 
     print "couldn't fork \n";} 

else { 
     print "in child , now executing \n"; 
exec('cd utpsm_run_automation && perl utpsm_lts_server.pl') 
     or die "can't run server.pl in sabkuch child \n"; 
} 

выход мой сценарий все еще висит, и оператор печати «в ребенке в настоящее время выполнения» получает работать в два раза, я не понимаю, почему, я работаю в основном на ассемблере, следовательно, это все новое мне. помощь будет оценена.