perlipc

СОДЕРЖАНИЕ

• ИМЯ
• ОПИСАНИЕ
• Сигналы
  • Обработка сигнала SIGHUP в демонах
  • Отложенные сигналы (безопасные сигналы)
• Именованные каналы
• Использование open() для Взаимодействия между процессами
  • Дескрипторы файлов
  • Фоновые процессы
  • Полная диссоциация потомка от родителя
  • Безопасные открытия каналов
  • Избежание тупиков в каналах
  • Двунаправленная коммуникация с другим процессом
  • Двунаправленная коммуникация с самим собой
• Сокеты: Клиент/серверная коммуникация
  • Ограничители строк Интернет-соединений
  • Интернет-клиенты и серверы TCP
  • Клиенты и серверы Unix-доменных сокетов TCP
• Клиенты TCP с IO::Socket
  • Простой клиент
  • Клиент Webget
  • Интерактивный клиент с IO::Socket
• Серверы TCP с IO::Socket
• UDP: Передача сообщений
• SysV IPC
• ПРИМЕЧАНИЯ
• ОШИБКИ
• АВТОР
• СМОТРИТЕ ТАКЖЕ

ИМЯ

perlipc - Взаимодействие процессов в Perl (сигналы, fifo, каналы, безопасные подпроцессы, сокеты и семафоры)

ОПИСАНИЕ

Базовые средства взаимодействия между процессами в Perl основаны на старых добрых Unix-сигналах, именованных каналах, каналах открытия, процедурах Berkeley сокетов и вызовах SysV IPC. Каждое используется в немного разных ситуациях.

Сигналы

Perl использует простую модель обработки сигналов: хеш %SIG содержит имена или ссылки на пользовательские обработчики сигналов. Эти обработчики вызываются с аргументом, который является именем сигнала, вызвавшего его. Сигнал может быть сгенерирован намеренно, например, с помощью комбинации клавиш Control-C или Control-Z, отправлен другому процессу или сгенерирован ядром при возникновении специальных событий, например, при завершении дочернего процесса, при исчерпании стека памяти процесса или достижении лимита размера файла процесса.

Например, чтобы перехватить сигнал прерывания, настройте обработчик следующим образом:

our $shucks;

sub catch_zap {
    my $signame = shift;
    $shucks++;
    die "Somebody sent me a SIG$signame";
}
$SIG{INT} = __PACKAGE__ . "::catch_zap";
$SIG{INT} = \&catch_zap;  # best strategy

До версии Perl 5.8.0 требовалось сделать в обработчике как можно меньше; обратите внимание, что всё, что мы делаем, это устанавливаем глобальную переменную и затем генерируем исключение. Это связано с тем, что на большинстве систем библиотеки не являются реентерабельными; в частности, функции выделения памяти и ввода/вывода не являются таковыми. Это означало, что выполнение практически любых действий в обработчике теоретически могло вызвать ошибку памяти и последующую дамп ядра - см. "Отложенные сигналы (безопасные сигналы)" ниже.

Имена сигналов — это те, которые перечислены kill -l на вашей системе, или вы можете получить их, используя CPAN-модуль IPC::Signal.

Вы также можете назначить строки "IGNORE" или "DEFAULT" как обработчик, в этом случае Perl попытается игнорировать сигнал или выполнить стандартные действия.

На большинстве платформ Unix сигнал CHLD (иногда также известный как CLD) имеет особое поведение относительно значения "IGNORE". Установка $SIG{CHLD} в "IGNORE" на такой платформе предотвращает создание процессов-зомби, когда родительский процесс не wait() свои дочерние процессы (т. е. дочерние процессы автоматически собираются). Вызов wait() с $SIG{CHLD} установленным в "IGNORE" обычно возвращает -1 на таких платформах.

Некоторые сигналы не могут быть ни перехвачены, ни проигнорированы, например, сигналы KILL и STOP (но не TSTP). Обратите внимание, что игнорирование сигналов приводит к их исчезновению. Если вы хотите только временно заблокировать сигналы, не теряя их, необходимо использовать модуль POSIX, функцию sigprocmask.

Отправка сигнала отрицательному идентификатору процесса означает отправку сигнала всей группе процессов Unix. Следующий код отправляет сигнал о завершении работы всем процессам в текущей группе процессов и устанавливает $SIG{HUP} в "IGNORE", чтобы не убить себя:

# block scope for local
{
    local $SIG{HUP} = "IGNORE";
    kill HUP => -getpgrp();
    # snazzy writing of: kill("HUP", -getpgrp())
}

Еще один интересный сигнал для отправки — сигнал с номером ноль. Это не влияет на дочерний процесс, а вместо этого проверяет, жив он или изменил свои идентификаторы.

unless (kill 0 => $kid_pid) {
    warn "something wicked happened to $kid_pid";
}

Сигнал с номером ноль может завершиться неудачей, если у вас нет разрешения отправить сигнал процессу, действительный или сохранённый UID которого не идентичен реальному или эффективному UID отправляющего процесса, даже если процесс жив. Вы можете определить причину сбоя, используя $! или %!.

unless (kill(0 => $pid) || $!{EPERM}) {
    warn "$pid looks dead";
}

Также вы можете использовать анонимные функции для простых обработчиков сигналов:

$SIG{INT} = sub { die "\nOutta here!\n" };

Обработчики SIGCHLD требуют особого внимания. Если второй дочерний процесс умирает во время обработки сигнала, вызванного смертью первого, мы не получим другого сигнала. Поэтому здесь нужен цикл, иначе мы оставим несобранный дочерний процесс в виде процесса-зомби. И в следующий раз, когда два дочерних процесса умрут, мы получим ещё одного зомби и так далее.

use POSIX ":sys_wait_h";
$SIG{CHLD} = sub {
    while ((my $child = waitpid(-1, WNOHANG)) > 0) {
        $Kid_Status{$child} = $?;
    }
};
# do something that forks...

Будьте осторожны: qx(), system() и некоторые модули для вызова внешних команд выполняют fork(), а затем wait() для получения результата. Таким образом, ваш обработчик сигналов будет вызван. Поскольку wait() уже был вызван system() или qx(), wait() в обработчике сигналов не обнаружит больше процессов-зомби и, следовательно, заблокируется.

Лучший способ предотвратить эту проблему — использовать waitpid(), как в следующем примере:

use POSIX ":sys_wait_h"; # for nonblocking read

my %children;

$SIG{CHLD} = sub {
    # don't change $! and $? outside handler
    local ($!, $?);
    while ( (my $pid = waitpid(-1, WNOHANG)) > 0 ) {
        delete $children{$pid};
        cleanup_child($pid, $?);
    }
};

while (1) {
    my $pid = fork();
    die "cannot fork" unless defined $pid;
    if ($pid == 0) {
        # ...
        exit 0;
    } else {
        $children{$pid}=1;
        # ...
        system($command);
        # ...
   }
}

Обработка сигналов также используется для таймаутов в Unix. При условии безопасного нахождения внутри блока eval{}, вы устанавливаете обработчик сигналов для перехвата сигналов alarm и планируете доставку одного сигнала через заданное количество секунд. Затем попробуйте выполнить вашу блокирующую операцию, очистив alarm, когда она выполнится, но не раньше, чем вы выйдете из блока eval{}. Если сигнал сработает, вы используете die() для выхода из блока.

Вот пример:

my $ALARM_EXCEPTION = "alarm clock restart";
eval {
    local $SIG{ALRM} = sub { die $ALARM_EXCEPTION };
    alarm 10;
    flock($fh, 2)    # blocking write lock
                    || die "cannot flock: $!";
    alarm 0;
};
if ($@ && $@ !~ quotemeta($ALARM_EXCEPTION)) { die }

Если выполняемая операция с таймаутом — system() или qx(), этот метод может привести к появлению процессов-зомби. Если это для вас важно, вам необходимо выполнить свой собственный fork() и exec(), а затем убить нежелательный дочерний процесс.

Для более сложной обработки сигналов вы можете обратиться к стандартному модулю POSIX. К сожалению, он практически не документирован, но в файле ext/POSIX/t/sigaction.t из дистрибутива Perl есть примеры.

Обработка сигнала SIGHUP в демонах

Процесс, который обычно запускается при загрузке системы и завершается при её выключении, называется демоном (Disk And Execution MONitor). Если у демона есть файл конфигурации, который изменяется после запуска процесса, должен быть способ указать этому процессу перечитать свой файл конфигурации без остановки процесса. Многие демоны предоставляют эту возможность с помощью обработчика сигнала SIGHUP. Чтобы указать демону перечитать файл, просто отправьте ему сигнал SIGHUP.

Следующий пример реализует простой демон, который перезапускается каждый раз при получении сигнала SIGHUP. Фактический код находится в подпрограмме code(), которая просто выводит отладочную информацию, чтобы показать, что она работает; её необходимо заменить реальным кодом.

#!/usr/bin/perl

use v5.36;

use POSIX ();
use FindBin ();
use File::Basename ();
use File::Spec::Functions qw(catfile);

$| = 1;

# make the daemon cross-platform, so exec always calls the script
# itself with the right path, no matter how the script was invoked.
my $script = File::Basename::basename($0);
my $SELF  = catfile($FindBin::Bin, $script);

# POSIX unmasks the sigprocmask properly
$SIG{HUP} = sub {
    print "got SIGHUP\n";
    exec($SELF, @ARGV)        || die "$0: couldn't restart: $!";
};

code();

sub code {
    print "PID: $$\n";
    print "ARGV: @ARGV\n";
    my $count = 0;
    while (1) {
        sleep 2;
        print ++$count, "\n";
    }
}

Отложенные сигналы (безопасные сигналы)

До версии Perl 5.8.0 установка кода Perl для обработки сигналов подвергала вас опасности из-за двух факторов. Во-первых, немногие системные библиотечные функции являются реентерабельными. Если сигнал прерывает выполнение Perl во время выполнения одной функции (например, malloc(3) или printf(3)), а ваш обработчик сигналов затем снова вызывает эту функцию, может возникнуть непредсказуемое поведение — часто дамп ядра. Во-вторых, сам Perl не является реентерабельным на самых низких уровнях. Если сигнал прерывает Perl во время изменения внутренних структур данных Perl, может произойти аналогичное непредсказуемое поведение.

Зная это, можно было сделать две вещи: быть параноиком или прагматиком. Параноидальный подход заключался в выполнении в обработчике сигналов как можно меньше действий. Установите существующую целочисленную переменную, у которой уже есть значение, и вернитесь. Это не помогает, если вы находитесь в медленном системном вызове, который просто перезапустится. Это означает, что вам нужно die к longjmp(3), чтобы выйти из обработчика. Даже это немного легкомысленно для настоящего параноика, который избегает die в обработчике, потому что система действительно хочет вас запутать.

Прагматичный подход заключался в том, чтобы сказать: «Я знаю риски, но предпочитаю удобство», и выполнить любые действия в обработчике сигналов, подготовившись к исправлению дампов ядра время от времени.

Perl 5.8.0 и более поздние версии избегают этих проблем, «откладывая» сигналы. То есть, когда система отправляет сигнал процессу (в код C, реализующий Perl), устанавливается флаг, и обработчик возвращается немедленно. Затем в стратегических «безопасных» точках интерпретатора Perl (например, когда он собирается выполнить новый код операции) проверяются флаги, и выполняется обработчик Perl из %SIG. Схема «отложенных» сигналов обеспечивает гораздо большую гибкость в программировании обработчиков сигналов, поскольку нам известно, что интерпретатор Perl находится в безопасном состоянии и что мы не находимся внутри системной библиотечной функции при вызове обработчика. Однако реализация отличается от предыдущих версий Perl следующим образом:

Длительные операции

Так как интерпретатор Perl проверяет флаги сигналов только перед выполнением новой операции, сигнал, пришедший во время длительной операции (например, операции с регулярными выражениями над очень большой строкой), не будет замечен до завершения текущей операции.

Если сигнал определенного типа генерируется несколько раз во время операции (например, от мелкого таймера), обработчик этого сигнала будет вызван только один раз после завершения операции; все остальные экземпляры будут отброшены. Кроме того, если очередь сигналов вашей системы заполнится до такой степени, что будут сигналы, которые были сгенерированы, но еще не обработаны (и, следовательно, не отложены) к моменту завершения операции, эти сигналы могут быть обработаны и отложены во время последующих операций, что может привести к неожиданным результатам. Например, вы можете увидеть доставленные сигналы тревоги даже после вызова alarm(0), так как последний останавливает генерацию сигналов тревоги, но не отменяет доставку сигналов тревоги, сгенерированных, но еще не обработанных. Не полагайтесь на поведение, описанное в этом абзаце, поскольку это побочные эффекты текущей реализации и они могут измениться в будущих версиях Perl.

Прерывание ввода-вывода

Когда сигнал отправляется (например, SIGINT от нажатия Ctrl+C), операционная система прерывает операции ввода-вывода, такие как read(2), которые используются для реализации функции readline() Perl, оператора <>. В более старых версиях Perl обработчик вызывался немедленно (и так как read не является «опасным», это работало хорошо). В схеме «отложенного» вызова обработчик не вызывается немедленно, и если Perl использует системную библиотеку stdio, эта библиотека может перезапустить read без возврата в Perl, чтобы дать ему возможность вызвать обработчик %SIG. Если это происходит на вашей системе, решением является использование уровня :perlio для выполнения ввода-вывода – по крайней мере, для тех дескрипторов, которые вы хотите иметь возможность прерывать сигналами. (Уровень :perlio проверяет флаги сигналов и вызывает обработчики %SIG перед возобновлением операции ввода-вывода.)

По умолчанию в Perl 5.8.0 и более поздних версиях автоматически используется уровень :perlio.

Обратите внимание, что не рекомендуется обращаться к файловому дескриптору внутри обработчика сигнала, где этот сигнал прервал операцию ввода-вывода на том же самом дескрипторе. Хотя perl будет стараться не упасть, нет гарантий целостности данных; например, некоторые данные могут быть потеряны или записаны дважды.

Некоторые функции сетевой библиотеки, такие как gethostbyname(), известны тем, что имеют свои собственные реализации таймаутов, которые могут конфликтовать с вашими таймаутами. Если у вас возникают проблемы с такими функциями, попробуйте использовать функцию POSIX sigaction(), которая обходит безопасные сигналы Perl. Будьте осторожны, что это может привести к возможной порче памяти, как описано выше.

Вместо установки $SIG{ALRM}:

local $SIG{ALRM} = sub { die "alarm" };

попробуйте что-то вроде следующего:

use POSIX qw(SIGALRM);
POSIX::sigaction(SIGALRM,
                 POSIX::SigAction->new(sub { die "alarm" }))
         || die "Error setting SIGALRM handler: $!\n";

Еще один способ отключить поведение безопасного сигнала локально – использовать модуль Perl::Unsafe::Signals из CPAN, который влияет на все сигналы.

Перезапускаемые системные вызовы

На системах, которые поддерживали это, более ранние версии Perl использовали флаг SA_RESTART при установке обработчиков %SIG. Это означало, что перезапускаемые системные вызовы продолжали выполняться, а не возвращались при поступлении сигнала. Для своевременной доставки отложенных сигналов Perl 5.8.0 и более поздние версии не используют SA_RESTART. Вследствие этого, перезапускаемые системные вызовы могут завершиться ошибкой (с $! установленным в EINTR) в тех местах, где они ранее успешно работали.

Уровень по умолчанию :perlio повторно пытается выполнить read, write и close как описано выше; прерванные wait и waitpid вызовы всегда будут повторно выполняться.

Сигналы как «ошибки»

Некоторые сигналы, такие как SEGV, ILL, BUS и FPE, генерируются ошибками обращения к виртуальной памяти и аналогичными «ошибками». Обычно они приводят к аварийному завершению: обработчик Perl уровня мало что может с ними сделать. Поэтому Perl доставляет их немедленно, а не пытается отложить.

Можно перехватить их с помощью обработчика %SIG (см. perlvar), но помимо обычных проблем с «опасными» сигналами, сигнал, вероятно, будет переброшен немедленно по возвращении из обработчика сигнала, поэтому такой обработчик должен die или exit вместо этого.

Сигналы, сгенерированные состоянием операционной системы

В некоторых операционных системах определенные обработчики сигналов должны «что-то сделать» перед возвратом. Один пример – CHLD или CLD, которые указывают на завершение дочернего процесса. В некоторых операционных системах ожидается, что обработчик сигнала wait для завершенного дочернего процесса. В таких системах схема отложенных сигналов не будет работать для этих сигналов: она не выполняет wait. Снова ошибка будет выглядеть как цикл, так как операционная система будет повторно отправлять сигнал, потому что есть завершенные дочерние процессы, которые еще не были wait.

Если вы хотите вернуть старое поведение сигналов, несмотря на возможную порчу памяти, установите переменную среды PERL_SIGNALS в значение "unsafe". Эта функция появилась впервые в Perl 5.8.1.

Именованные каналы

Именованный канал (часто называемый FIFO) – это старый механизм Unix IPC для взаимодействия процессов на одной машине. Он работает так же, как обычные анонимные каналы, за исключением того, что процессы состыкуются, используя имя файла, и не обязательно связаны.

Для создания именованного канала используйте функцию POSIX::mkfifo().

use POSIX qw(mkfifo);
mkfifo($path, 0700)     ||  die "mkfifo $path failed: $!";

Вы также можете использовать команду Unix mknod(1) или, в некоторых системах, mkfifo(1). Однако они могут отсутствовать в вашем стандартном пути.

# system return val is backwards, so && not ||
#
$ENV{PATH} .= ":/etc:/usr/etc";
if  (      system("mknod",  $path, "p")
        && system("mkfifo", $path) )
{
    die "mk{nod,fifo} $path failed";
}

FIFO удобно, когда вы хотите подключить процесс к несвязанному. При открытии FIFO программа будет блокироваться, пока на другом конце не появится что-то.

Например, предположим, что вы хотите, чтобы ваш файл .signature был именованным каналом, на другом конце которого находится программа Perl. Теперь каждый раз, когда любая программа (например, почтовый клиент, читатель новостей, программа finger и т. д.) пытается прочитать из этого файла, читающая программа будет читать новую подпись из вашей программы. Мы будем использовать оператор проверки канала -p, чтобы определить, случайно ли кто-то (или что-то) удалил наш FIFO.

chdir();    # go home
my $FIFO = ".signature";

while (1) {
    unless (-p $FIFO) {
        unlink $FIFO;   # discard any failure, will catch later
        require POSIX;  # delayed loading of heavy module
        POSIX::mkfifo($FIFO, 0700)
                              || die "can't mkfifo $FIFO: $!";
    }

    # next line blocks till there's a reader
    open (my $fh, ">", $FIFO) || die "can't open $FIFO: $!";
    print $fh "John Smith (smith\@host.org)\n", `fortune -s`;
    close($fh)                || die "can't close $FIFO: $!";
    sleep 2;                # to avoid dup signals
}

Использование open() для IPC

Базовая операция open() Perl также может использоваться для односторонней межпроцессной связи, если указать режим открытия как |- или -|. Вот как запустить что-то в дочернем процессе, которому вы собираетесь писать:

open(my $spooler, "|-", "cat -v | lpr -h 2>/dev/null")
                    || die "can't fork: $!";
local $SIG{PIPE} = sub { die "spooler pipe broke" };
print $spooler "stuff\n";
close $spooler      || die "bad spool: $! $?";

А вот как запустить дочерний процесс, из которого вы собираетесь читать:

open(my $status, "-|", "netstat -an 2>&1")
                    || die "can't fork: $!";
while (<$status>) {
    next if /^(tcp|udp)/;
    print;
}
close $status       || die "bad netstat: $! $?";

Обратите внимание, что эти операции представляют собой полные виртуальные Unix-fork, что может означать некорректную реализацию на всех не-Unix-системах. См. "open" в perlport для получения информации о переносимости.

В форме open() с двумя аргументами открытие канала можно выполнить, добавив или вставив символ канала перед или после второго аргумента:

open(my $spooler, "| cat -v | lpr -h 2>/dev/null")
                    || die "can't fork: $!";
open(my $status, "netstat -an 2>&1 |")
                    || die "can't fork: $!";

Это можно использовать даже на системах, которые не поддерживают виртуальные Unix-fork, но это, возможно, позволяет коду, предназначенному для чтения файлов, неожиданно выполнять программы. Если можно быть уверенным, что определенная программа – это скрипт Perl, ожидающий имена файлов в @ARGV, используя форму open() с двумя аргументами или оператор <>, то умный программист может написать что-то вроде этого:

% program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile

и независимо от того, из какой оболочки он вызывается, программа Perl будет читать из файла f1, процесса cmd1, стандартного ввода (tmpfile в этом случае), файла f2, команды cmd2 и, наконец, файла f3. Довольно изящно, не так ли?

Вы можете заметить, что вы можете использовать обратные кавычки для достижения примерно такого же эффекта, что и открытие канала для чтения:

print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
die "bad netstatus ($?)" if $?;

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

Будьте внимательны к проверке возвращаемых значений как из open(), так и из close(). Если вы пишете в канал, вы также должны обрабатывать SIGPIPE. В противном случае, подумайте, что произойдёт, когда вы откроете канал для команды, которой нет: открытие, скорее всего, успешно завершится (оно только отражает успешность fork()), но затем ваш вывод завершится ошибкой – впечатляюще. Perl не может знать, работала ли команда, потому что ваша команда фактически выполняется в отдельном процессе, чья функция exec() могла завершиться неудачно. Поэтому, в то время как читатели недопустимых команд возвращают просто быстрый EOF, пишущие в недопустимые команды получат сигнал, на который они должны быть готовы. Подумайте о следующем:

open(my $fh, "|-", "bogus") || die "can't fork: $!";
print $fh "bang\n";         #  neither necessary nor sufficient
                            #  to check print retval!
close($fh)                  || die "can't close: $!";

Причина, по которой не проверяется возвращаемое значение из print(), заключается в буферизации каналов; физические записи откладываются. Это не сработает до закрытия, и произойдет SIGPIPE. Чтобы перехватить его, вы можете использовать это:

$SIG{PIPE} = "IGNORE";
open(my $fh, "|-", "bogus") || die "can't fork: $!";
print $fh "bang\n";
close($fh)                  || die "can't close: status=$?";

Дескрипторы файлов

И основной процесс, и все созданные им дочерние процессы делят одни и те же дескрипторы файлов STDIN, STDOUT и STDERR. Если оба процесса пытаются получить к ним доступ одновременно, могут произойти странные вещи. Возможно, вам также потребуется закрыть или повторно открыть дескрипторы файлов для дочернего процесса. Вы можете обойти это, открывая канал с помощью open(), но на некоторых системах это означает, что дочерний процесс не может пережить родительский.

Фоновые процессы

Вы можете запустить команду в фоновом режиме с помощью:

system("cmd &");

Стандартный вывод и стандартная ошибка команды (а возможно, и стандартный ввод, в зависимости от вашей оболочки) будут такими же, как у родительского процесса. Вам не нужно будет перехватывать SIGCHLD из-за двойного fork; см. ниже для подробностей.

Полное отделение дочернего процесса от родительского

В некоторых случаях (например, при запуске серверных процессов) вам потребуется полностью отделить дочерний процесс от родительского. Это часто называют демонизацией. Хорошо себя ведущий демон также перейдёт в корневой каталог, чтобы не препятствовать размонтированию файловой системы, содержащей каталог, из которого он был запущен, и перенаправит свои стандартные дескрипторы файлов в и из /dev/null, чтобы случайный вывод не отображался на терминале пользователя.

use POSIX "setsid";

sub daemonize {
    chdir("/")                     || die "can't chdir to /: $!";
    open(STDIN,  "<", "/dev/null") || die "can't read /dev/null: $!";
    open(STDOUT, ">", "/dev/null") || die "can't write /dev/null: $!";
    defined(my $pid = fork())      || die "can't fork: $!";
    exit if $pid;              # non-zero now means I am the parent
    (setsid() != -1)           || die "Can't start a new session: $!";
    open(STDERR, ">&", STDOUT) || die "can't dup stdout: $!";
}

Функция fork() должна предшествовать функции setsid(), чтобы убедиться, что вы не являетесь лидером группы процессов; функция setsid() завершится неудачно, если вы им являетесь. Если на вашей системе нет функции setsid(), откройте /dev/tty и используйте функцию TIOCNOTTY ioctl() на ней. См. tty(4) для подробностей.

Пользователи, не работающие с Unix, должны проверить свой модуль Your_OS::Process в поисках других возможных решений.

Безопасные открытия каналов

Ещё один интересный подход к межпроцессной связи (IPC) — заставить вашу единственную программу работать в многопроцессном режиме и обмениваться данными между своими процессами. Двухаргументная форма функции open() примет в качестве аргумента файл "-|" или "|-", чтобы сделать очень интересную вещь: она порождает дочерний процесс, связанный с открытым дескриптором файла. Дочерний процесс выполняет ту же программу, что и родительский. Это полезно для безопасного открытия файла при выполнении под предполагаемым UID или GID, например. Если вы откроете канал в минус, вы сможете записать в открытый дескриптор файла, и ваш ребёнок найдёт это в своём STDIN. Если вы откроете канал из минус, вы сможете прочитать из открытого дескриптора файла всё, что ваш ребёнок запишет в свой STDOUT.

my $PRECIOUS = "/path/to/some/safe/file";
my $sleep_count;
my $pid;
my $kid_to_write;

do {
    $pid = open($kid_to_write, "|-");
    unless (defined $pid) {
        warn "cannot fork: $!";
        die "bailing out" if $sleep_count++ > 6;
        sleep 10;
    }
} until defined $pid;

if ($pid) {                 # I am the parent
    print $kid_to_write @some_data;
    close($kid_to_write)    || warn "kid exited $?";
} else {                    # I am the child
    # drop permissions in setuid and/or setgid programs:
    ($>, $)) = ($<, $();
    open (my $outfile, ">", $PRECIOUS)
                            || die "can't open $PRECIOUS: $!";
    while (<STDIN>) {
        print $outfile;     # child STDIN is parent $kid_to_write
    }
    close($outfile)         || die "can't close $PRECIOUS: $!";
    exit(0);                # don't forget this!!
}

Другое распространённое применение этого конструкта — когда вам нужно выполнить что-то без вмешательства оболочки. С помощью system() это просто, но вы не можете безопасно использовать открытие канала или обратные кавычки. Это потому, что нет способа помешать оболочке получить доступ к вашим аргументам. Вместо этого используйте более низкий уровень управления, чтобы напрямую вызвать exec().

Вот безопасное использование обратных кавычек или открытия канала для чтения:

my $pid = open(my $kid_to_read, "-|");
defined($pid)            || die "can't fork: $!";

if ($pid) {             # parent
    while (<$kid_to_read>) {
                        # do something interesting
    }
    close($kid_to_read)  || warn "kid exited $?";

} else {                # child
    ($>, $)) = ($<, $(); # suid only
    exec($program, @options, @args)
                         || die "can't exec program: $!";
    # NOTREACHED
}

И вот безопасное открытие канала для записи:

my $pid = open(my $kid_to_write, "|-");
defined($pid)            || die "can't fork: $!";

$SIG{PIPE} = sub { die "whoops, $program pipe broke" };

if ($pid) {             # parent
    print $kid_to_write @data;
    close($kid_to_write) || warn "kid exited $?";

} else {                # child
    ($>, $)) = ($<, $();
    exec($program, @options, @args)
                         || die "can't exec program: $!";
    # NOTREACHED
}

Очень легко создать тупик процесса, используя эту форму open(), или, в общем, при использовании pipe() с несколькими дочерними процессами. Приведённый выше пример «безопасный», потому что он простой и вызывает exec(). Смотрите "Избегание тупиков при открытии каналов" для общих принципов безопасности, но есть дополнительные особенности с безопасными открытиями каналов.

В частности, если вы открыли канал с использованием open $fh, "|-", то вы не можете просто использовать close() в родительском процессе для закрытия ненужного писателя. Рассмотрим этот код:

my $pid = open(my $writer, "|-");        # fork open a kid
defined($pid)               || die "first fork failed: $!";
if ($pid) {
    if (my $sub_pid = fork()) {
        defined($sub_pid)   || die "second fork failed: $!";
        close($writer)      || die "couldn't close writer: $!";
        # now do something else...
    }
    else {
        # first write to $writer
        # ...
        # then when finished
        close($writer)      || die "couldn't close writer: $!";
        exit(0);
    }
}
else {
    # first do something with STDIN, then
    exit(0);
}

В приведённом примере истинный родительский процесс не хочет писать в дескриптор файла $writer, поэтому он закрывает его. Однако, поскольку $writer был открыт с использованием open $fh, "|-", у него есть специальное поведение: закрытие вызывает waitpid() (см. "waitpid" в perlfunc), которое ожидает завершения дочернего процесса. Если дочерний процесс ждёт чего-то, что происходит в разделе «сделать что-то ещё», у вас будет тупик.

Это также может быть проблемой с промежуточными дочерними процессами в более сложном коде, который будет вызывать waitpid() для всех открытых дескрипторов файлов во время глобального уничтожения — в произвольном порядке.

Чтобы решить эту проблему, необходимо вручную использовать pipe(), fork() и форму open(), которая устанавливает один дескриптор файла на другой, как показано ниже:

pipe(my $reader, my $writer)   || die "pipe failed: $!";
my $pid = fork();
defined($pid)                  || die "first fork failed: $!";
if ($pid) {
    close $reader;
    if (my $sub_pid = fork()) {
        defined($sub_pid)      || die "first fork failed: $!";
        close($writer)         || die "can't close writer: $!";
    }
    else {
        # write to $writer...
        # ...
        # then  when finished
        close($writer)         || die "can't close writer: $!";
        exit(0);
    }
    # write to $writer...
}
else {
    open(STDIN, "<&", $reader) || die "can't reopen STDIN: $!";
    close($writer)             || die "can't close writer: $!";
    # do something...
    exit(0);
}

Начиная с Perl 5.8.0, вы также можете использовать списочную форму open для каналов. Это предпочтительно, когда вы хотите избежать интерпретации оболочкой метасимволов, которые могут присутствовать в вашей строке команды.

Например, вместо использования:

open(my $ps_pipe, "-|", "ps aux") || die "can't open ps pipe: $!";

Можно использовать любой из этих вариантов:

open(my $ps_pipe, "-|", "ps", "aux")
                                  || die "can't open ps pipe: $!";

my @ps_args = qw[ ps aux ];
open(my $ps_pipe, "-|", @ps_args)
                                  || die "can't open @ps_args|: $!";

Поскольку для open() передано более трёх аргументов, она порождает команду ps(1) без запуска оболочки и считывает её стандартный вывод через дескриптор файла $ps_pipe. Соответствующая синтаксическая конструкция для записи в каналы команд — использование "|-" вместо "-|".

Это, признаться, довольно глупый пример, поскольку вы используете строковые литералы, чьё содержимое абсолютно безопасно. Поэтому нет причины прибегать к более сложному для чтения многоаргументному открытию канала. Однако всякий раз, когда вы не можете быть уверены, что аргументы программы свободны от метасимволов оболочки, следует использовать более сложную форму open(). Например:

my @grep_args = ("egrep", "-i", $some_pattern, @many_files);
open(my $grep_pipe, "-|", @grep_args)
                    || die "can't open @grep_args|: $!";

Здесь предпочтительнее многоаргументная форма открытия канала, поскольку шаблон и даже сами имена файлов могут содержать метасимволы.

Избегание тупиков при открытии каналов

Всякий раз, когда у вас есть более одного дочернего процесса, вы должны быть осторожны, чтобы каждый закрывал ту часть любых каналов, созданных для межпроцессного обмена данными, которую он не использует. Это потому, что любой дочерний процесс, читающий из канала и ожидающий EOF, никогда не получит его и, следовательно, никогда не завершится. Закрытие канала одним процессом недостаточно; последний процесс, имеющий канал открытым, должен закрыть его, чтобы он мог прочитать EOF.

Некоторые встроенные функции Unix помогают предотвратить это в большинстве случаев. Например, дескрипторы файлов имеют флаг «закрыть при exec», который устанавливается массово под управлением переменной $^F. Это для того, чтобы любые дескрипторы файлов, которые вы явно не направили в STDIN, STDOUT или STDERR дочернего процесса, будут автоматически закрыты.

Всегда явно и немедленно вызывайте close() для записывающего конца любого канала, если этот процесс не записывает в него. Даже если вы не вызываете close() явно, Perl всё равно закроет все дескрипторы файлов при глобальном уничтожении. Как уже обсуждалось ранее, если эти дескрипторы файлов были открыты с помощью безопасного открытия канала, это приведёт к вызову waitpid(), что, опять же, может привести к тупику.

Взаимодействие с другим процессом в двух направлениях

Хотя это работает довольно хорошо для односторонней связи, а как насчёт двусторонней связи? Самый очевидный подход не работает:

# THIS DOES NOT WORK!!
open(my $prog_for_reading_and_writing, "| some program |")

Если вы забудете use warnings, вы пропустите полезное диагностическое сообщение:

Can't do bidirectional pipe at -e line 1.

Если вы действительно хотите, вы можете использовать стандартную open2() из модуля IPC::Open2 для захвата обоих концов. Также есть open3() в IPC::Open3 для трёхоборонного ввода-вывода, так что вы также можете захватить STDERR своего дочернего процесса, но тогда потребуется неудобный цикл select() и не позволит вам использовать обычные операции ввода Perl.

Если вы посмотрите на его исходный код, вы увидите, что open2() использует низкоуровневые примитивы, такие как вызовы систем pipe() и exec(), для создания всех соединений. Хотя было бы эффективнее использовать socketpair(), это было бы ещё менее переносимым, чем есть. Функции open2() и open3() вряд ли будут работать где-либо, кроме Unix-систем или систем, претендующих на соответствие POSIX.

Вот пример использования open2():

use IPC::Open2;
my $pid = open2(my $reader, my $writer, "cat -un");
print $writer "stuff\n";
my $got = <$reader>;
waitpid $pid, 0;

Проблема в том, что буферизация действительно испортит вам жизнь. Даже если ваш дескриптор файла $writer автоматически сбрасывается, так что процесс на другом конце получает ваши данные вовремя, вы обычно не можете ничего сделать, чтобы заставить этот процесс передать ваши данные вам столь же быстро. В этом особом случае мы, возможно, смогли бы это сделать, потому что мы дали команде cat флаг -u, чтобы она работала без буферизации. Но очень мало команд предназначены для работы через каналы, поэтому это редко работает, если вы сами не написали программу на другом конце двунаправленного канала.

Решение этой проблемы — использование библиотеки, которая использует псевдотерминалы, чтобы ваша программа вела себя более разумно. Таким образом, вам не придётся контролировать исходный код программы, которую вы используете. Модуль Expect из CPAN также решает подобные вопросы. Для работы этого модуля требуются два других модуля из CPAN, IO::Pty и IO::Stty. Он устанавливает псевдотерминал для взаимодействия с программами, которые настаивают на общении с драйвером устройства терминала. Если ваша система поддерживается, это может быть ваш лучший вариант.

Взаимодействие с самим собой в двух направлениях

Если хотите, вы можете сделать низкоуровневые вызовы систем pipe() и fork(), чтобы склеить это вручную. Этот пример взаимодействует только с собой, но вы могли бы снова открыть соответствующие дескрипторы STDIN и STDOUT и вызвать другие процессы. (В следующем примере отсутствует надлежащая проверка ошибок.)

#!/usr/bin/perl
# pipe1 - bidirectional communication using two pipe pairs
#         designed for the socketpair-challenged
use v5.36;
use IO::Handle;  # enable autoflush method before Perl 5.14
pipe(my $parent_rdr, my $child_wtr);  # XXX: check failure?
pipe(my $child_rdr,  my $parent_wtr); # XXX: check failure?
$child_wtr->autoflush(1);
$parent_wtr->autoflush(1);

if ($pid = fork()) {
    close $parent_rdr;
    close $parent_wtr;
    print $child_wtr "Parent Pid $$ is sending this\n";
    chomp(my $line = <$child_rdr>);
    print "Parent Pid $$ just read this: '$line'\n";
    close $child_rdr; close $child_wtr;
    waitpid($pid, 0);
} else {
    die "cannot fork: $!" unless defined $pid;
    close $child_rdr;
    close $child_wtr;
    chomp(my $line = <$parent_rdr>);
    print "Child Pid $$ just read this: '$line'\n";
    print $parent_wtr "Child Pid $$ is sending this\n";
    close $parent_rdr;
    close $parent_wtr;
    exit(0);
}

Но вам на самом деле не нужно делать два вызова pipe(). Если у вас есть вызов системы socketpair(), он сделает всё за вас.

#!/usr/bin/perl
# pipe2 - bidirectional communication using socketpair
#   "the best ones always go both ways"

use v5.36;
use Socket;
use IO::Handle;  # enable autoflush method before Perl 5.14

# We say AF_UNIX because although *_LOCAL is the
# POSIX 1003.1g form of the constant, many machines
# still don't have it.
socketpair(my $child, my $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
                            ||  die "socketpair: $!";

$child->autoflush(1);
$parent->autoflush(1);

if ($pid = fork()) {
    close $parent;
    print $child "Parent Pid $$ is sending this\n";
    chomp(my $line = <$child>);
    print "Parent Pid $$ just read this: '$line'\n";
    close $child;
    waitpid($pid, 0);
} else {
    die "cannot fork: $!" unless defined $pid;
    close $child;
    chomp(my $line = <$parent>);
    print "Child Pid $$ just read this: '$line'\n";
    print $parent "Child Pid $$ is sending this\n";
    close $parent;
    exit(0);
}

Сокеты: взаимодействие клиент-сервер

Хотя это не полностью ограничено системами на базе Unix (например, WinSock на ПК обеспечивает поддержку сокетов, как и некоторые библиотеки VMS), у вас могут отсутствовать сокеты на вашей системе, в этом случае этот раздел, вероятно, не будет вам полезен. С помощью сокетов вы можете делать как виртуальные цепи, такие как потоки TCP, так и дейтаграммы, такие как пакеты UDP. В зависимости от вашей системы, вы можете сделать ещё больше.

Perl-функции для работы с сокетами имеют те же названия, что и соответствующие системные вызовы на C, но их аргументы обычно отличаются по двум причинам. Во-первых, дескрипторы файлов Perl работают по-другому, чем дескрипторы файлов C. Во-вторых, Perl уже знает длину своих строк, поэтому вам не нужно передавать эту информацию.

Одна из основных проблем со старым, домилленниальным кодом сокетов в Perl заключалась в том, что он использовал жёстко закодированные значения для некоторых констант, что сильно ухудшало переносимость. Если вы когда-либо увидите код, который делает что-либо вроде явного задания $AF_INET = 2, вы знаете, что вас ждёт большая беда. Неизмеримо лучший подход — использование модуля Socket, который более надёжно предоставляет доступ к различным константам и функциям, которые вам понадобятся.

Если вы не пишете сервер/клиент для существующего протокола, такого как NNTP или SMTP, вам следует подумать о том, как сервер узнает, когда клиент закончил общение, и наоборот. Большинство протоколов основаны на однострочных сообщениях и ответах (так что одна сторона знает, что другая закончила, когда она получает «\n») или многострочных сообщениях и ответах, которые заканчиваются точкой на пустой строке («\n.\n» завершает сообщение/ответ).

Окончания строки в Интернете

Окончание строки в Интернете — «\015\012». В ASCII-вариантах Unix это обычно можно записать как «\r\n», но в других системах «\r\n» иногда может быть «\015\015\012», «\012\012\015» или чем-то совершенно другим. Стандарты определяют запись «\015\012» для соответствия (будьте строги в том, что вы предоставляете), но они также рекомендуют принимать одиночную «\012» на входе (будьте снисходительны в том, что вы требуете). Мы не всегда хорошо это делали в коде в этом справочном руководстве, но если вы не работаете на компьютере Mac из очень далёких времён, до появления Unix, то, вероятно, у вас всё будет хорошо.

Клиенты и серверы TCP в Интернете

Используйте сокеты домена Интернета, когда вам нужно взаимодействие клиент-сервер, которое может распространяться на машины за пределами вашей системы.

Вот пример TCP-клиента, использующего сокеты домена Интернета:

#!/usr/bin/perl
use v5.36;
use Socket;

my $remote  = shift || "localhost";
my $port    = shift || 2345;  # random port
if ($port =~ /\D/) { $port = getservbyname($port, "tcp") }
die "No port" unless $port;
my $iaddr   = inet_aton($remote)       || die "no host: $remote";
my $paddr   = sockaddr_in($port, $iaddr);

my $proto   = getprotobyname("tcp");
socket(my $sock, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
connect($sock, $paddr)              || die "connect: $!";
while (my $line = <$sock>) {
    print $line;
}

close ($sock)                        || die "close: $!";
exit(0);

И вот соответствующий сервер для него. Мы оставим адрес как INADDR_ANY, чтобы ядро могло выбрать соответствующий интерфейс на многоадресных хостах. Если вы хотите использовать определённый интерфейс (например, внешний интерфейс шлюза или брандмауэра), замените это на ваш реальный адрес.

#!/usr/bin/perl -T
use v5.36;
BEGIN { $ENV{PATH} = "/usr/bin:/bin" }
use Socket;
use Carp;
my $EOL = "\015\012";

sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" }

my $port  = shift || 2345;
die "invalid port" unless $port =~ /^ \d+ $/x;

my $proto = getprotobyname("tcp");

socket(my $server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt($server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
                                              || die "setsockopt: $!";
bind($server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen($server, SOMAXCONN)                    || die "listen: $!";

logmsg "server started on port $port";

for (my $paddr; $paddr = accept(my $client, $server); close $client) {
    my($port, $iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr, AF_INET);

    logmsg "connection from $name [",
            inet_ntoa($iaddr), "]
            at port $port";

    print $client "Hello there, $name, it's now ",
                    scalar localtime(), $EOL;
}

И вот многозадачная версия. Она многозадачна в том, что, как и большинство типичных серверов, она порождает (fork()s) дочерний сервер для обработки запроса клиента, так что мастер-сервер может быстро вернуться к обслуживанию нового клиента.

#!/usr/bin/perl -T
use v5.36;
BEGIN { $ENV{PATH} = "/usr/bin:/bin" }
use Socket;
use Carp;
my $EOL = "\015\012";

sub spawn;  # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" }

my $port  = shift || 2345;
die "invalid port" unless $port =~ /^ \d+ $/x;

my $proto = getprotobyname("tcp");

socket(my $server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt($server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
                                              || die "setsockopt: $!";
bind($server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen($server, SOMAXCONN)                    || die "listen: $!";

logmsg "server started on port $port";

my $waitedpid = 0;

use POSIX ":sys_wait_h";
use Errno;

sub REAPER {
    local $!;   # don't let waitpid() overwrite current error
    while ((my $pid = waitpid(-1, WNOHANG)) > 0 && WIFEXITED($?)) {
        logmsg "reaped $waitedpid" . ($? ? " with exit $?" : "");
    }
    $SIG{CHLD} = \&REAPER;  # loathe SysV
}

$SIG{CHLD} = \&REAPER;

while (1) {
    my $paddr = accept(my $client, $server) || do {
        # try again if accept() returned because got a signal
        next if $!{EINTR};
        die "accept: $!";
    };
    my ($port, $iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr, AF_INET);

    logmsg "connection from $name [",
           inet_ntoa($iaddr),
           "] at port $port";

    spawn $client, sub {
        $| = 1;
        print "Hello there, $name, it's now ",
              scalar localtime(),
              $EOL;
        exec "/usr/games/fortune"       # XXX: "wrong" line terminators
            or confess "can't exec fortune: $!";
    };
    close $client;
}

sub spawn {
    my $client = shift;
    my $coderef = shift;

    unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") {
        confess "usage: spawn CLIENT CODEREF";
    }

    my $pid;
    unless (defined($pid = fork())) {
        logmsg "cannot fork: $!";
        return;
    }
    elsif ($pid) {
        logmsg "begat $pid";
        return; # I'm the parent
    }
    # else I'm the child -- go spawn

    open(STDIN,  "<&", $client)   || die "can't dup client to stdin";
    open(STDOUT, ">&", $client)   || die "can't dup client to stdout";
    ## open(STDERR, ">&", STDOUT) || die "can't dup stdout to stderr";
    exit($coderef->());
}

Этот сервер утруждает себя клонированием дочернего варианта через fork() для каждого входящего запроса. Таким образом, он может обрабатывать множество запросов одновременно, хотя вам это не всегда нужно. Даже если вы не используете fork(), listen() позволит столько ожидающих соединений. Серверы с fork() должны быть особенно осторожны при очистке своих умерших детей (называемых «зомби» в терминологии Unix), иначе вы быстро заполните свою таблицу процессов. Подпрограмма REAPER используется здесь для вызова waitpid() для любых завершившихся дочерних процессов, гарантируя, что они завершатся чисто и не присоединятся к рядам живых мертвецов.

Внутри цикла while мы вызываем accept() и проверяем, возвращает ли оно ложное значение. Это обычно указывает на то, что необходимо сообщить об ошибке системы. Однако, с введением безопасных сигналов (см. «Отложенные сигналы (Безопасные сигналы)» выше) в Perl 5.8.0 означает, что accept() также может быть прервано, когда процесс получает сигнал. Это обычно происходит, когда один из порождённых дочерних процессов завершается и уведомляет родительский процесс с сигналом CHLD.

Если accept() прерывается сигналом, $! будет установлено в EINTR. Если это произойдёт, мы можем безопасно перейти к следующей итерации цикла и к другому вызову accept(). Важно, чтобы ваш обработчик сигналов не изменял значение $!, иначе этот тест, скорее всего, провалится. В подпрограмме REAPER мы создаём локальную копию $! перед вызовом waitpid(). Когда waitpid() устанавливает $! в ECHILD, как это неизбежно происходит, когда у него больше нет ждущих дочерних процессов, он обновляет локальную копию и оставляет исходную неизменённой.

Вы должны использовать флаг -T для включения проверки на заражённые данные (см. perlsec), даже если мы не выполняем setuid или setgid. Это всегда хорошая идея для серверов или любых программ, выполняемых от имени другого пользователя (например, сценариев CGI), поскольку это уменьшает вероятность того, что внешние пользователи смогут скомпрометировать вашу систему. Обратите внимание, что Perl может быть скомпилирован без поддержки проверки на заражённые данные. Существуют два разных режима: в одном режиме -T будет молча ничего не делать. В другом режиме -T приводит к ошибке.

Давайте рассмотрим ещё один TCP-клиент. Этот клиент подключается к TCP-сервису «time» на нескольких разных машинах и показывает, насколько отличаются их часы от системы, на которой он выполняется:

#!/usr/bin/perl
use v5.36;
use Socket;

my $SECS_OF_70_YEARS = 2208988800;
sub ctime { scalar localtime(shift() || time()) }

my $iaddr = gethostbyname("localhost");
my $proto = getprotobyname("tcp");
my $port = getservbyname("time", "tcp");
my $paddr = sockaddr_in(0, $iaddr);

$| = 1;
printf "%-24s %8s %s\n", "localhost", 0, ctime();

foreach my $host (@ARGV) {
    printf "%-24s ", $host;
    my $hisiaddr = inet_aton($host)     || die "unknown host";
    my $hispaddr = sockaddr_in($port, $hisiaddr);
    socket(my $socket, PF_INET, SOCK_STREAM, $proto)
                                        || die "socket: $!";
    connect($socket, $hispaddr)         || die "connect: $!";
    my $rtime = pack("C4", ());
    read($socket, $rtime, 4);
    close($socket);
    my $histime = unpack("N", $rtime) - $SECS_OF_70_YEARS;
    printf "%8d %s\n", $histime - time(), ctime($histime);
}

Unix-доменные TCP-клиенты и серверы

Это хорошо для клиентов и серверов в домене Интернета, но что насчёт локальных коммуникаций? Хотя вы можете использовать ту же настройку, иногда вы не хотите этого делать. Unix-доменные сокеты локальны для текущего хоста и часто используются внутри для реализации каналов. В отличие от сокетов домена Интернета, Unix-доменные сокеты могут отображаться в файловой системе с помощью команды ls(1).

% ls -l /dev/log
srw-rw-rw-  1 root            0 Oct 31 07:23 /dev/log

Вы можете проверить их с помощью файлового теста Perl -S:

unless (-S "/dev/log") {
    die "something's wicked with the log system";
}

Вот пример Unix-доменного клиента:

#!/usr/bin/perl
use v5.36;
use Socket;

my $rendezvous = shift || "catsock";
socket(my $sock, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect($sock, sockaddr_un($rendezvous))  || die "connect: $!";
while (defined(my $line = <$sock>)) {
    print $line;
}
exit(0);

И вот соответствующий сервер. Вам не нужно беспокоиться о глупых сетевых терминаторах здесь, потому что Unix-доменные сокеты гарантированно находятся на localhost, и поэтому всё работает правильно.

#!/usr/bin/perl -T
use v5.36;
use Socket;
use Carp;

BEGIN { $ENV{PATH} = "/usr/bin:/bin" }
sub spawn;  # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" }

my $NAME = "catsock";
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname("tcp");

socket(my $server, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
unlink($NAME);
bind  ($server, $uaddr)                     || die "bind: $!";
listen($server, SOMAXCONN)                  || die "listen: $!";

logmsg "server started on $NAME";

my $waitedpid;

use POSIX ":sys_wait_h";
sub REAPER {
    my $child;
    while (($waitedpid = waitpid(-1, WNOHANG)) > 0) {
        logmsg "reaped $waitedpid" . ($? ? " with exit $?" : "");
    }
    $SIG{CHLD} = \&REAPER;  # loathe SysV
}

$SIG{CHLD} = \&REAPER;


for ( $waitedpid = 0;
      accept(my $client, $server) || $waitedpid;
      $waitedpid = 0, close $client)
{
    next if $waitedpid;
    logmsg "connection on $NAME";
    spawn $client, sub {
        print "Hello there, it's now ", scalar localtime(), "\n";
        exec("/usr/games/fortune")  || die "can't exec fortune: $!";
    };
}

sub spawn {
    my $client = shift();
    my $coderef = shift();

    unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") {
        confess "usage: spawn CLIENT CODEREF";
    }

    my $pid;
    unless (defined($pid = fork())) {
        logmsg "cannot fork: $!";
        return;
    }
    elsif ($pid) {
        logmsg "begat $pid";
        return; # I'm the parent
    }
    else {
        # I'm the child -- go spawn
    }

    open(STDIN,  "<&", $client)
        || die "can't dup client to stdin";
    open(STDOUT, ">&", $client)
        || die "can't dup client to stdout";
    ## open(STDERR, ">&", STDOUT)
    ##  || die "can't dup stdout to stderr";
    exit($coderef->());
}

Как вы видите, это удивительно похоже на сервер TCP в домене Интернета, настолько, что мы опустили несколько дублирующихся функций — spawn(), logmsg(), ctime() и REAPER() — которые такие же, как и в другом сервере.

Так почему же вы захотите использовать Unix-доменный сокет вместо более простого именованного канала? Потому что именованный канал не предоставляет сеансы. Вы не можете отличить данные одного процесса от данных другого. С программированием сокетов вы получаете отдельный сеанс для каждого клиента; вот почему accept() принимает два аргумента.

Например, предположим, что у вас есть долго работающий демо-сервер базы данных, к которому вы хотите дать доступ из веб-приложения, но только через CGI-интерфейс. У вас будет небольшая, простая CGI-программа, которая выполняет любые проверки и логирование, которые вам нравятся, а затем действует как Unix-доменный клиент и подключается к вашему частному серверу.

TCP-клиенты с IO::Socket

Для тех, кто предпочитает более высокий уровень интерфейса программирования сокетов, модуль IO::Socket предоставляет объектно-ориентированный подход. Если по какой-то причине у вас нет этого модуля, вы можете просто загрузить IO::Socket с CPAN, где вы также найдёте модули, предоставляющие простые интерфейсы к следующим системам: DNS, FTP, Ident (RFC 931), NIS и NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet и Time — и это лишь некоторые из них.

Простой клиент

Вот клиент, который создаёт TCP-соединение с сервисом «daytime» на порту 13 хоста «localhost» и выводит всё, что сервер там захочет предоставить.

#!/usr/bin/perl
use v5.36;
use IO::Socket;
my $remote = IO::Socket::INET->new(
                    Proto    => "tcp",
                    PeerAddr => "localhost",
                    PeerPort => "daytime(13)",
                )
             || die "can't connect to daytime service on localhost";
while (<$remote>) { print }

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

Wed May 14 08:40:46 MDT 1997

Вот что означают эти параметры конструктора new():

Proto

Это протокол, который нужно использовать. В данном случае дескриптор сокета, возвращаемый функцией, будет подключён к TCP-сокету, потому что нам нужно ориентированное на поток подключение, то есть такое, которое действует примерно так же, как обычный файл. Не все сокеты являются такого типа. Например, протокол UDP может использоваться для создания сокета датаграмм, используемого для обмена сообщениями.

PeerAddr

Это имя или интернет-адрес удалённого хоста, на котором работает сервер. Мы могли бы указать более длинное имя, например, "www.perl.com", или адрес, например, "207.171.7.72". В демонстрационных целях мы использовали специальное имя хоста "localhost", которое всегда должно означать текущую машину, на которой вы работаете. Соответствующий интернет-адрес для localhost — "127.0.0.1", если вы предпочитаете использовать его.

PeerPort

Это имя службы или номер порта, к которому мы хотим подключиться. Мы могли бы обойтись только "daytime" на системах с правильно настроенным файлом служб,[ПРИМЕЧАНИЕ: Файл служб можно найти в /etc/services на Unix-системах.] но здесь мы указали номер порта (13) в скобках. Использование только числа также сработало бы, но числовые литералы заставляют внимательных программистов нервничать.

Клиент webget

Вот простой клиент, который принимает удалённый хост для получения документа и затем список файлов для получения от этого хоста. Это более интересный клиент, чем предыдущий, потому что он сначала отправляет что-то серверу перед получением ответа сервера.

#!/usr/bin/perl
use v5.36;
use IO::Socket;
unless (@ARGV > 1) { die "usage: $0 host url ..." }
my $host = shift(@ARGV);
my $EOL = "\015\012";
my $BLANK = $EOL x 2;
for my $document (@ARGV) {
    my $remote = IO::Socket::INET->new( Proto     => "tcp",
                                        PeerAddr  => $host,
                                        PeerPort  => "http(80)",
              )     || die "cannot connect to httpd on $host";
    $remote->autoflush(1);
    print $remote "GET $document HTTP/1.0" . $BLANK;
    while ( <$remote> ) { print }
    close $remote;
}

Предполагается, что веб-сервер, обрабатывающий HTTP-сервис, находится на стандартном порту 80. Если сервер, к которому вы пытаетесь подключиться, находится на другом порту, например, 1080 или 8080, вы должны указать его как пару именованных параметров, PeerPort => 8080. Метод autoflush используется на сокете, потому что в противном случае система бы буферизировала отправленный нами вывод. (Если вы используете древний Mac, вам также нужно будет заменить все "\n" в вашем коде, который отправляет данные по сети, на "\015\012".)

Подключение к серверу — это только первая часть процесса: после подключения вам нужно использовать язык сервера. Каждый сервер в сети имеет свой собственный небольшой язык команд, который он ожидает в качестве входных данных. Строка, которую мы отправляем серверу, начиная с «GET», находится в синтаксисе HTTP. В данном случае мы просто запрашиваем каждый указанный документ. Да, мы действительно создаём новое соединение для каждого документа, даже если это один и тот же хост. Именно так всегда нужно было общаться с HTTP. Недавние версии веб-браузеров могут запросить у удалённого сервера оставить подключение открытым некоторое время, но сервер не обязан выполнять такой запрос.

Вот пример запуска этой программы, которую мы назовём webget:

% webget www.perl.com /guanaco.html
HTTP/1.1 404 File Not Found
Date: Thu, 08 May 1997 18:02:32 GMT
Server: Apache/1.2b6
Connection: close
Content-type: text/html

<HEAD><TITLE>404 File Not Found</TITLE></HEAD>
<BODY><H1>File Not Found</H1>
The requested URL /guanaco.html was not found on this server.<P>
</BODY>

Хорошо, это не очень интересно, потому что он не нашёл этот конкретный документ. Но длинный ответ не поместился бы на эту страницу.

Для более функциональной версии этой программы вы должны обратиться к программе lwp-request, включённой в модули LWP с CPAN.

Интерактивный клиент с IO::Socket

Хорошо, это всё хорошо, если вы хотите отправить одну команду и получить один ответ, но как насчёт настройки чего-то полностью интерактивного, наподобие того, как работает telnet? Таким образом, вы можете вводить строку, получать ответ, вводить строку, получать ответ и так далее.

Этот клиент сложнее двух предыдущих, но если у вас есть система, которая поддерживает мощный fork вызов, решение не так сложно. После того, как вы установили соединение с любой службой, с которой хотите пообщаться, вызовите fork для клонирования вашего процесса. Каждый из этих двух идентичных процессов выполняет очень простую задачу: родительский процесс копирует всё из сокета в стандартный вывод, в то время как дочерний процесс одновременно копирует всё из стандартного ввода в сокет. Для достижения той же цели с использованием только одного процесса было бы намного сложнее, потому что легче написать два процесса для выполнения одной задачи, чем написать один процесс для выполнения двух задач. (Этот принцип простоты — краеугольный камень философии Unix, а также хорошей разработки программного обеспечения, поэтому он распространился и на другие системы.)

Вот код:

#!/usr/bin/perl
use v5.36;
use IO::Socket;

unless (@ARGV == 2) { die "usage: $0 host port" }
my ($host, $port) = @ARGV;

# create a tcp connection to the specified host and port
my $handle = IO::Socket::INET->new(Proto     => "tcp",
                                   PeerAddr  => $host,
                                   PeerPort  => $port)
           || die "can't connect to port $port on $host: $!";

$handle->autoflush(1);       # so output gets there right away
print STDERR "[Connected to $host:$port]\n";

# split the program into two processes, identical twins
die "can't fork: $!" unless defined(my $kidpid = fork());

# the if{} block runs only in the parent process
if ($kidpid) {
    # copy the socket to standard output
    while (defined (my $line = <$handle>)) {
        print STDOUT $line;
    }
    kill("TERM", $kidpid);   # send SIGTERM to child
}
# the else{} block runs only in the child process
else {
    # copy standard input to the socket
    while (defined (my $line = <STDIN>)) {
        print $handle $line;
    }
    exit(0);                # just in case
}

Функция kill в блоке if родительского процесса предназначена для отправки сигнала нашему дочернему процессу, который сейчас выполняется в блоке else, как только удалённый сервер закроет свой конец подключения.

Если удалённый сервер отправляет данные побайтово, и вам нужны эти данные немедленно без ожидания новой строки (чего может и не произойти), вы можете заменить цикл while в родительском процессе следующим:

my $byte;
while (sysread($handle, $byte, 1) == 1) {
    print STDOUT $byte;
}

Выполнение системного вызова для каждого байта, который вы хотите прочитать, не очень эффективно (мягко говоря), но проще объяснить и работает достаточно хорошо.

TCP-серверы с IO::Socket

Как всегда, настройка сервера немного сложнее, чем запуск клиента. Модель заключается в том, что сервер создаёт специальный сокет, который ничего не делает, кроме прослушивания определённого порта на подключение. Он делает это, вызывая метод IO::Socket::INET->new() с несколько другими аргументами, чем клиент.

Протокол

Как и наши клиенты, мы по-прежнему укажем "tcp" здесь.

Локальный порт

Мы указываем локальный порт в аргументе LocalPort, чего мы не делали для клиента. Это имя службы или номер порта, на котором вы хотите быть сервером. (В Unix порты ниже 1024 ограничены для суперпользователя.) В нашем примере мы будем использовать порт 9000, но вы можете использовать любой порт, который сейчас не используется в вашей системе. Если вы попытаетесь использовать уже занятый, получите сообщение «Адрес уже используется». В Unix команда netstat -a покажет, какие службы в настоящее время имеют серверы.

Очередь подключений

Параметр Listen устанавливается на максимальное количество ожидающих подключений, которые мы можем принять, прежде чем отклонить входящих клиентов. Подумайте об этом как о очереди ожидания звонков для вашего телефона. Модуль Socket низкого уровня имеет специальный символ для системного максимума, который равен SOMAXCONN.

Переиспользование адреса

Параметр Reuse необходим для того, чтобы мы могли перезапустить наш сервер вручную, не дожидаясь нескольких минут, чтобы позволить системам очистить буферы.

После создания обобщённого сокета сервера с указанными выше параметрами сервер ждёт подключения нового клиента. Сервер блокируется в методе accept, который в конечном итоге принимает двустороннее подключение от удалённого клиента. (Убедитесь, что вы автоматически сбрасываете буферы этого дескриптора сокета, чтобы избежать буферизации.)

Для повышения удобства использования наш сервер запрашивает у пользователя команды. Большинство серверов этого не делают. Из-за запроса без новой строки вам нужно использовать вариант интерактивного клиента sysread выше.

Этот сервер принимает один из пяти различных команд, отправляя результат обратно клиенту. В отличие от большинства сетевых серверов, этот сервер обрабатывает только одного входящего клиента за раз. Многозадачные серверы рассматриваются в главе 16 руководства Camel.

Вот код.

#!/usr/bin/perl
use v5.36;
use IO::Socket;
use Net::hostent;      # for OOish version of gethostbyaddr

my $PORT = 9000;       # pick something not in use

my $server = IO::Socket::INET->new( Proto     => "tcp",
                                    LocalPort => $PORT,
                                    Listen    => SOMAXCONN,
                                    Reuse     => 1);

die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";

while (my $client = $server->accept()) {
  $client->autoflush(1);
  print $client "Welcome to $0; type help for command list.\n";
  my $hostinfo = gethostbyaddr($client->peeraddr);
  printf "[Connect from %s]\n",
         $hostinfo ? $hostinfo->name : $client->peerhost;
  print $client "Command? ";
  while ( <$client>) {
    next unless /\S/;     # blank line
    if    (/quit|exit/i)  { last                                      }
    elsif (/date|time/i)  { printf $client "%s\n", scalar localtime() }
    elsif (/who/i )       { print  $client `who 2>&1`                 }
    elsif (/cookie/i )    { print  $client `/usr/games/fortune 2>&1`  }
    elsif (/motd/i )      { print  $client `cat /etc/motd 2>&1`       }
    else {
      print $client "Commands: quit date who cookie motd\n";
    }
  } continue {
     print $client "Command? ";
  }
  close $client;
}

UDP: Передача сообщений

Другой вид клиент-серверной настройки использует не соединения, а сообщения. UDP-связь предполагает значительно меньшую нагрузку, но также обеспечивает меньшую надёжность, так как нет гарантий, что сообщения вообще придут, не говоря уже о том, что они придут в правильном порядке и без искажений. Тем не менее, UDP предлагает некоторые преимущества по сравнению с TCP, включая возможность «вещания» или «многоадресной рассылки» множеству целевых хостов сразу (обычно в вашей локальной подсети). Если вы чрезмерно обеспокоены надёжностью и начинаете встраивать проверки в свою систему сообщений, то, вероятно, следует начать с использования просто TCP.

UDP-датаграммы — это не поток байтов и не следует обрабатывать их как таковые. Это делает использование механизмов ввода-вывода с внутренней буферизацией, таких как stdio (т. е. print() и аналогичные функции), особенно неудобным. Используйте syswrite() или лучше send(), как в примере ниже.

Вот программа UDP, аналогичная ранее приведенному примеру интернет-клиента TCP. Однако вместо проверки одного хоста за раз, версия UDP будет проверять множество хостов асинхронно, имитируя многоадресную рассылку, а затем используя select() для ожидания ввода-вывода с таймаутом. Для аналогичной работы с TCP необходимо использовать отдельный дескриптор сокета для каждого хоста.

#!/usr/bin/perl
use v5.36;
use Socket;
use Sys::Hostname;

my $SECS_OF_70_YEARS = 2_208_988_800;

my $iaddr = gethostbyname(hostname());
my $proto = getprotobyname("udp");
my $port = getservbyname("time", "udp");
my $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick

socket(my $socket, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
bind($socket, $paddr)                           || die "bind: $!";

$| = 1;
printf "%-12s %8s %s\n",  "localhost", 0, scalar localtime();
my $count = 0;
for my $host (@ARGV) {
    $count++;
    my $hisiaddr = inet_aton($host)         || die "unknown host";
    my $hispaddr = sockaddr_in($port, $hisiaddr);
    defined(send($socket, 0, 0, $hispaddr)) || die "send $host: $!";
}

my $rout = my $rin = "";
vec($rin, fileno($socket), 1) = 1;

# timeout after 10.0 seconds
while ($count && select($rout = $rin, undef, undef, 10.0)) {
    my $rtime = "";
    my $hispaddr = recv($socket, $rtime, 4, 0) || die "recv: $!";
    my ($port, $hisiaddr) = sockaddr_in($hispaddr);
    my $host = gethostbyaddr($hisiaddr, AF_INET);
    my $histime = unpack("N", $rtime) - $SECS_OF_70_YEARS;
    printf "%-12s ", $host;
    printf "%8d %s\n", $histime - time(), scalar localtime($histime);
    $count--;
}

Этот пример не включает повторные попытки и, следовательно, может не связаться с доступным хостом. Наиболее распространённая причина этого — переполнение очередей на хосте-отправителе, если количество хостов для связи достаточно велико.

SysV IPC

Хотя SysV IPC не так широко используется, как сокеты, он всё же имеет некоторые интересные применения. Однако вы не можете использовать SysV IPC или Berkeley mmap() для общего использования переменной между несколькими процессами. Это происходит потому, что Perl перераспределяет вашу строку, когда вы этого не хотите. Вы можете изучить модули IPC::Shareable или threads::shared для этого.

Вот небольшой пример использования общей памяти.

use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);

my $size = 2000;
my $id = shmget(IPC_PRIVATE, $size, S_IRUSR | S_IWUSR);
defined($id)                    || die "shmget: $!";
print "shm key $id\n";

my $message = "Message #1";
shmwrite($id, $message, 0, 60)  || die "shmwrite: $!";
print "wrote: '$message'\n";
shmread($id, my $buff, 0, 60)      || die "shmread: $!";
print "read : '$buff'\n";

# the buffer of shmread is zero-character end-padded.
substr($buff, index($buff, "\0")) = "";
print "un" unless $buff eq $message;
print "swell\n";

print "deleting shm $id\n";
shmctl($id, IPC_RMID, 0)        || die "shmctl: $!";

Вот пример использования семафора:

use IPC::SysV qw(IPC_CREAT);

my $IPC_KEY = 1234;
my $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT);
defined($id)                    || die "semget: $!";
print "sem id $id\n";

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

# create a semaphore

my $IPC_KEY = 1234;
my $id = semget($IPC_KEY, 0, 0);
defined($id)                    || die "semget: $!";

my $semnum  = 0;
my $semflag = 0;

# "take" semaphore
# wait for semaphore to be zero
my $semop = 0;
my $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);

# Increment the semaphore count
$semop = 1;
my $opstring2 = pack("s!s!s!", $semnum, $semop,  $semflag);
my $opstring  = $opstring1 . $opstring2;

semop($id, $opstring)   || die "semop: $!";

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

# "give" the semaphore
# run this in the original process and you will see
# that the second process continues

my $IPC_KEY = 1234;
my $id = semget($IPC_KEY, 0, 0);
die unless defined($id);

my $semnum  = 0;
my $semflag = 0;

# Decrement the semaphore count
my $semop = -1;
my $opstring = pack("s!s!s!", $semnum, $semop, $semflag);

semop($id, $opstring)   || die "semop: $!";

Код SysV IPC выше был написан давно, и он определённо выглядит громоздким. Для более современного вида см. модуль IPC::SysV.

Небольшой пример, демонстрирующий использование очередей сообщений SysV:

use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);

my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
defined($id)                || die "msgget failed: $!";

my $sent      = "message";
my $type_sent = 1234;

msgsnd($id, pack("l! a*", $type_sent, $sent), 0)
                            || die "msgsnd failed: $!";

msgrcv($id, my $rcvd_buf, 60, 0, 0)
                            || die "msgrcv failed: $!";

my($type_rcvd, $rcvd) = unpack("l! a*", $rcvd_buf);

if ($rcvd eq $sent) {
    print "okay\n";
} else {
    print "not okay\n";
}

msgctl($id, IPC_RMID, 0)    || die "msgctl failed: $!\n";

ПРИМЕЧАНИЯ

Большинство этих процедур тихо, но вежливо возвращают undef при ошибке, вместо того, чтобы завершать вашу программу из-за неперехваченного исключения. (На самом деле, некоторые новые функции преобразования Socket вызывают croak() при плохих аргументах.) Поэтому крайне важно проверять значения возврата этих функций. Всегда начинайте свои программы сокетов таким образом для оптимального успеха, и не забудьте добавить флаг проверки некорректных данных -T к строке #! для серверов:

#!/usr/bin/perl -T
use v5.36;
use sigtrap;
use Socket;

ОШИБКИ

Эти процедуры все создают специфичные для системы проблемы с переносимостью. Как отмечалось ранее, Perl во многом зависит от ваших C-библиотек для поведения в системе. Вероятно, безопаснее предположить некорректную семантику SysV для сигналов и придерживаться простых операций сокета TCP и UDP; например, не пытайтесь передавать открытые дескрипторы файлов через локальный UDP-сокет, если хотите, чтобы ваш код был переносимым.

АВТОР

Том Кристиансен, с периодическими следами исходной версии Ларри Уолла и предложениями от Perl Портеров.

См. также

В сетевом программировании есть гораздо больше, чем это, но это должно помочь вам начать.

Для смелых программистов незаменимым учебником является книга «Unix Network Programming, 2-е издание, Том 1» У. Ричарда Стивенса (издана Prentice-Hall). Большинство книг по сетевому программированию рассматривают эту тему с точки зрения программиста на C; перевод на Perl предоставлен как упражнение для читателя.

В документации IO::Socket(3) описывается библиотека объектов, а в документации Socket(3) описывается низкоуровневый интерфейс к сокетам. Помимо очевидных функций в perlfunc, вы также должны проверить файл modules на ближайшем сайте CPAN, особенно http://www.cpan.org/modules/00modlist.long.html#ID5_Networking_. См. perlmodlib или лучше всего — страницу вопросов-ответов по Perl для описания того, что такое CPAN и где его получить, если предыдущая ссылка не работает.

Раздел 5 файла modules CPAN посвящён «Сетевому программированию, управлению устройствами (модемы) и межпроцессной связи» и содержит множество нескомпилированных модулей, множество сетевых модулей, модули для чата и Expect, CGI-программирование, DCE, FTP, IPC, NNTP, прокси, Ptty, RPC, SNMP, SMTP, Telnet, потоки и ToolTalk — лишь некоторые из них.