perlipc

СОДЕРЖАНИЕ

• ИМЯ
• ОПИСАНИЕ
• Сигналы
  • Обработка сигнала SIGHUP в демонах
  • Отложенные сигналы (безопасные сигналы)
• Именованные каналы
• Использование open() для Взаимодействия процессов
  • Дескрипторы файлов
  • Фоновые процессы
  • Полное отделение дочернего процесса от родительского
  • Безопасные открытия каналов
  • Избегание тупиков в каналах
  • Взаимодействие с другим процессом в двух направлениях
  • Взаимодействие с самим собой в двух направлениях
• Сокеты: Взаимодействие клиент/сервер
  • Ограничители строк в интернете
  • Клиенты и серверы TCP интернета
  • Клиенты и серверы TCP Unix-домена
• Клиенты 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 требовалось сделать как можно меньше в вашем обработчике; обратите внимание, что мы просто устанавливаем глобальную переменную и затем генерируем исключение. Это происходит потому, что в большинстве систем библиотеки не являются реентерабельными; в частности, функции выделения памяти и ввода-вывода не являются. Это означало, что почти любой код в обработчике теоретически мог вызвать ошибку памяти и последующую запись core дампа - см. "Отложенные сигналы (безопасные сигналы)" ниже.

Имена сигналов - это те, которые перечислены 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. Этот код отправляет сигнал hang-up всем процессам в текущей группе процессов и также устанавливает $SIG{HUP} в "IGNORE" , чтобы не убить себя:

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

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

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

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

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

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

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

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

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

Именованный канал (часто называемый FIFO) — это старый механизм IPC 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

Основное утверждение open() в Perl также может использоваться для однонаправленной межпроцессной связи, добавляя или вставляя символ канала в второй аргумент 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. Довольно здорово, да?

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

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 &");

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

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

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

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

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

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() для каналов или обратные кавычки. Это происходит, потому что нет способа помешать оболочке получить доступ к вашим аргументам. Вместо этого используйте более низкий уровень управления, чтобы непосредственно вызвать exec().

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

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, чтобы поймать оба конца. Также существует open3() в IPC::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» (будьте снисходительны к тому, что вы требуете). Мы не всегда очень хорошо это учитывали в коде в этом руководстве, но если вы не работаете на компьютере Mac из очень давних времён, до эпохи 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, как это неизбежно происходит, когда больше нет ожидающих дочерних процессов, он обновляет локальную копию и оставляет исходную неизменной.

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

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

#!/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 гарантированно находятся на localhost, и поэтому всё работает правильно.

#!/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-соединение с услугой «день» на порту 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-сокету, потому что мы хотим ориентированный на поток (stream-oriented) соединения, то есть такой, который ведет себя почти как обычный файл. Не все сокеты такого типа. Например, протокол UDP может быть использован для создания сокета дейтаграммы, используемого для передачи сообщений.

PeerAddr

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

PeerPort

Это имя службы или номер порта, к которому мы хотим подключиться. Мы могли бы обойтись только с "daytime" на системах с правильно настроенным файлом системных служб,[ПРИМЕЧАНИЕ: Файл системных служб находится в /etc/services на системах Unixy.] но здесь мы указали номер порта (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 устанавливается в максимальное количество ожидающих подключений, которые мы можем принять, прежде чем отклонить входящих клиентов. Подумайте об этом как о режиме ожидания вызова для вашего телефона. Модуль Socket низкого уровня имеет специальный символ для системного максимума — 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

Хотя SysV 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 Портеров.

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

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

Для смелых программистов незаменимым учебником является книга «Программирование сетевых приложений Unix, 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 посвящён «Сети, управлению устройствами (модемы) и межпроцессной связи» и содержит множество модулей для сетевого программирования, чата и операций Expect, программирования CGI, DCE, FTP, IPC, NNTP, прокси, Ptty, RPC, SNMP, SMTP, Telnet, потоков и ToolTalk — лишь некоторые из них.