perlipc

СОДЕРЖАНИЕ

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

ИМЯ

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

ОПИСАНИЕ

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

Сигналы

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

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

our $shucks;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

use POSIX ":sys_wait_h"; # for nonblocking read

my %children;

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

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

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

Вот пример:

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

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

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

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

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

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

#!/usr/bin/perl

use 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 во время изменения его внутренних структур данных, также может произойти непредсказуемое поведение.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

system("cmd &");

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

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

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

use POSIX "setsid";

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

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

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

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

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

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

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

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

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

Вот безопасный способ открыть канал для чтения с помощью обратных кавычек или функции open:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Например, вместо:

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

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

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

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

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

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

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

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

Избежание блокировок каналов

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

use strict;
use warnings;
use Socket;
use IO::Handle;  # enable autoflush method before Perl 5.14

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

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

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

Сокеты: Клиент-серверная связь

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

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

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

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

Разделители строк в Интернете

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

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

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

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

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

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

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

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

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

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

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

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

my $proto = getprotobyname("tcp");

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

logmsg "server started on port $port";

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

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

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

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

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

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

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

my $proto = getprotobyname("tcp");

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

logmsg "server started on port $port";

my $waitedpid = 0;

use POSIX ":sys_wait_h";
use Errno;

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

$SIG{CHLD} = \&REAPER;

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

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

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

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

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

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

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

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

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

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

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

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

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

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

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

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

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

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

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

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

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

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

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

#!/usr/bin/perl
use Socket;
use strict;
use warnings;

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

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

#!/usr/bin/perl -T
use strict;
use warnings;
use Socket;
use Carp;

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

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

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

logmsg "server started on $NAME";

my $waitedpid;

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

$SIG{CHLD} = \&REAPER;


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

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

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

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

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

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

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

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

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

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

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

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

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

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

Wed May 14 08:40:46 MDT 1997

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

Proto

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

PeerAddr

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

PeerPort

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

Клиент webget

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

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

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

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

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

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

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

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

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

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

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

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

Вот код:

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;

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

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

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

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

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

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

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

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

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

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

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

Proto

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

LocalPort

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

Listen

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

Reuse

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

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

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

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

Вот код.

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

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

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

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

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

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

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

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

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

#!/usr/bin/perl
use strict;
use warnings;
use Socket;
use Sys::Hostname;

my $SECS_OF_70_YEARS = 2_208_988_800;

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

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

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

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

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

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

SysV IPC

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

Вы можете изучить модули IPC::Shareable или threads::shared для этого.

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

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

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

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

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

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

Вот пример семафора:

use IPC::SysV qw(IPC_CREAT);

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

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

# create a semaphore

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

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

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

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

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

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

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

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

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

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

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

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

Вот небольшой пример демонстрации очередей сообщений SysV:

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

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

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

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

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

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

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

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

ПРИМЕЧАНИЯ

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

#!/usr/bin/perl -T
use strict;
use warnings;
use sigtrap;
use Socket;

ОШИБКИ

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

АВТОР

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

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

В сетях есть много другого, но этого должно быть достаточно, чтобы начать.

Для смелых программистов непременным учебником является Unix Network Programming, 2nd Edition, Volume 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 — это лишь несколько примеров.