perlipc

СОДЕРЖАНИЕ

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

НАЗВАНИЕ

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

ОПИСАНИЕ

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

Сигналы

Perl использует простую модель обработки сигналов: хеш %SIG содержит имена или ссылки на пользовательские обработчики сигналов. Эти обработчики вызываются со значением аргумента, которое представляет собой имя сигнала, вызвавшего обработку. Сигнал может быть сгенерирован преднамеренно из определенной последовательности нажатий клавиш, например, Ctrl+C или Ctrl+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";
}

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

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 strict;
use warnings;

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), которая используется для реализации функции Perl readline(), оператора <>. В более старых версиях 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, генерируются ошибками адресации виртуальной памяти и подобными «ошибками». Обычно они фатальны: обработчик Perl мало что может с ними сделать. Поэтому Perl доставляет их немедленно, а не пытается отложить.

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

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

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

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

Для создания именованного канала используйте функцию 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 (FIFO, "> $FIFO")  || die "can't open $FIFO: $!";
    print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
    close(FIFO)             || die "can't close $FIFO: $!";
    sleep 2;                # to avoid dup signals
}

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

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

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

Если можно быть уверенным, что конкретная программа — это скрипт Perl, ожидающий имена файлов в @ARGV, то умный программист может написать что-то вроде этого:

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

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

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

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

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

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

open(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(FH, "|bogus")  || die "can't fork: $!";
print FH "bang\n";
close(FH)           || die "can't close: status=$?";

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

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

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

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

system("cmd &");

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

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

В некоторых случаях (например, при запуске серверных процессов) вам нужно будет полностью отделить дочерний процесс от родительского. Это часто называется демонизацией. Хорошо себя ведущий демон также переместит текущую директорию в корневую директорию, чтобы не препятствовать размонтированию файловой системы, содержащей директорию, из которой он был запущен, и перенаправит свои стандартные дескрипторы файлов как из, так и в /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 to /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: $!";
}

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

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

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

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

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

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:
    ($EUID, $EGID) = ($UID, $GID);
    open (OUTFILE, "> $PRECIOUS")
                            || die "can't open $PRECIOUS: $!";
    while (<STDIN>) {
        print OUTFILE;      # child's STDIN is parent's KID_TO_WRITE
    }
    close(OUTFILE)          || die "can't close $PRECIOUS: $!";
    exit(0);                # don't forget this!!
}

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

Вот безопасный backtick или открытие канала для чтения:

my $pid = open(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
    ($EUID, $EGID) = ($UID, $GID); # suid only
    exec($program, @options, @args)
                        || die "can't exec program: $!";
    # NOTREACHED
}

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

my $pid = open(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
    ($EUID, $EGID) = ($UID, $GID);
    exec($program, @options, @args)
                        || die "can't exec program: $!";
    # NOTREACHED
}

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

В частности, если вы открыли трубу с помощью open FH, "|-", то вы не можете просто закрыть ненужного пишущего процесса с помощью close() в родительском процессе. Рассмотрим следующий код:

my $pid = open(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(READER, WRITER)        || die "pipe failed: $!";
$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(PS_PIPE, "ps aux|")    || die "can't open ps pipe: $!";

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

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

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

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

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

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

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

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

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

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

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

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

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

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

# THIS DOES NOT WORK!!
open(PROG_FOR_READING_AND_WRITING, "| some program |")

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

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

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

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

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

use FileHandle;
use IPC::Open2;
$pid = open2(*Reader, *Writer, "cat -un");
print Writer "stuff\n";
$got = <Reader>;

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

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

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

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

#!/usr/bin/perl -w
# pipe1 - bidirectional communication using two pipe pairs
#         designed for the socketpair-challenged
use IO::Handle;             # thousands of lines just for autoflush :-(
pipe(PARENT_RDR, CHILD_WTR);  # XXX: check failure?
pipe(CHILD_RDR,  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($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($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 -w
# pipe2 - bidirectional communication using socketpair
#   "the best ones always go both ways"

use Socket;
use IO::Handle;  # thousands of lines just for autoflush :-(

# We say AF_UNIX because although *_LOCAL is the
# POSIX 1003.1g form of the constant, many machines
# still don't have it.
socketpair(CHILD, 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($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($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" на входе (будьте снисходительны к тому, что вы требуете). Мы не всегда очень хорошо следовали этому в коде этого справочника, но если вы не работаете на компьютере Macintosh из очень давних времён, до эры Unix, то, вероятно, у вас всё будет в порядке.

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

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

Вот пример клиента TCP с использованием сокетов домена Интернета:

#!/usr/bin/perl -w
use strict;
use Socket;
my ($remote, $port, $iaddr, $paddr, $proto, $line);

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

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

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

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

#!/usr/bin/perl -Tw
use strict;
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(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 $paddr;

for ( ; $paddr = accept(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()) подчиненный сервер для обработки запроса клиента, чтобы мастер-сервер мог быстро вернуться к обслуживанию нового клиента.

#!/usr/bin/perl -Tw
use strict;
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(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;
my $paddr;

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) {
    $paddr = accept(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 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 $coderef = shift;

    unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") {
        confess "usage: spawn 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, как это неизбежно происходит, когда больше нет ожидающих дочерних процессов, он обновляет локальную копию и оставляет исходное значение без изменений.

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

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

#!/usr/bin/perl  -w
use strict;
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);
my($host);

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

foreach $host (@ARGV) {
    printf "%-24s ", $host;
    my $hisiaddr = inet_aton($host)     || die "unknown host";
    my $hispaddr = sockaddr_in($port, $hisiaddr);
    socket(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);
}

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

Это хорошо для клиентов и серверов интернет-домена, но что насчет локальных коммуникаций? Хотя вы можете использовать ту же настройку, иногда вы этого не хотите. 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 -w
use Socket;
use strict;
my ($rendezvous, $line);

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

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

#!/usr/bin/perl -Tw
use strict;
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(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(Client, Server) || $waitedpid;
      $waitedpid = 0, close Client)
{
    next if $waitedpid;
    logmsg "connection on $NAME";
    spawn sub {
        print "Hello there, it's now ", scalar localtime(), "\n";
        exec("/usr/games/fortune")  || die "can't exec fortune: $!";
    };
}

sub spawn {
    my $coderef = shift();

    unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") {
        confess "usage: spawn 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 -w
use IO::Socket;
$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) в скобках. Использование только номера также сработало бы, но числовые литералы заставляют внимательных программистов нервничать.

Обратите внимание, как значение, возвращённое конструктором new, используется в цикле while как дескриптор файла? Это называется непрямым дескриптором файла, скалярной переменной, содержащей дескриптор файла. Вы можете использовать его так же, как и обычный дескриптор файла. Например, вы можете прочитать одну строку так:

$line = <$handle>;

все остальные строки так:

@lines = <$handle>;

и отправить строку данных так:

print $handle "some data\n";

Клиент Webget

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

#!/usr/bin/perl -w
use IO::Socket;
unless (@ARGV > 1) { die "usage: $0 host url ..." }
$host = shift(@ARGV);
$EOL = "\015\012";
$BLANK = $EOL x 2;
for my $document (@ARGV) {
    $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 -w
use strict;
use IO::Socket;
my ($host, $port, $kidpid, $handle, $line);

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

# create a tcp connection to the specified host and port
$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($kidpid = fork());

# the if{} block runs only in the parent process
if ($kidpid) {
    # copy the socket to standard output
    while (defined ($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 ($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() с немного другими аргументами, чем у клиента.

Proto

Это используемый протокол. Как и наши клиенты, мы всё ещё укажем "tcp".

LocalPort

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

Listen

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

Reuse

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

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

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

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

Вот код. Мы будем

#!/usr/bin/perl -w
use IO::Socket;
use Net::hostent;      # for OOish version of gethostbyaddr

$PORT = 9000;          # pick something not in use

$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 ($client = $server->accept()) {
  $client->autoflush(1);
  print $client "Welcome to $0; type help for command list.\n";
  $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 -w
use strict;
use Socket;
use Sys::Hostname;

my ( $count, $hisiaddr, $hispaddr, $histime,
     $host, $iaddr, $paddr, $port, $proto,
     $rin, $rout, $rtime, $SECS_OF_70_YEARS);

$SECS_OF_70_YEARS = 2_208_988_800;

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

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

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

$rin = "";
vec($rin, fileno(SOCKET), 1) = 1;

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

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

SysV IPC

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

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

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

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

$message = "Message #1";
shmwrite($id, $message, 0, 60)  || die "shmwrite: $!";
print "wrote: '$message'\n";
shmread($id, $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);

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

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

# create a semaphore

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

$semnum  = 0;
$semflag = 0;

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

# Increment the semaphore count
$semop = 1;
$opstring2 = pack("s!s!s!", $semnum, $semop,  $semflag);
$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

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

$semnum  = 0;
$semflag = 0;

# Decrement the semaphore count
$semop = -1;
$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 -Tw
use strict;
use sigtrap;
use Socket;

ОШИБКИ

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

АВТОР

Том Кристиансен, с эпизодическими остатками оригинальной версии Ларри Уолла и предложениями от Perl Porters.

СМОТРИТЕ ТАКЖЕ

Сетей гораздо больше, чем это, но этого должно быть достаточно, чтобы начать.

Для смелых программистов незаменимым учебником является книга 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 FAQ для описания того, что такое CPAN и где его получить, если предыдущая ссылка не работает.

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