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 содержит имена или ссылки на установленные пользователем обработчики сигналов. Эти обработчики вызываются с аргументом, который является именем сигнала, который их вызвал. Сигнал может быть сгенерирован намеренно из определённой последовательности нажатия клавиш, например, Ctrl+C или Ctrl+Z, отправлен другому процессу, или сгенерирован ядром при возникновении особых событий, таких как завершение дочернего процесса, исчерпание места в стеке вашего собственного процесса или достижение лимита размера файла процесса.

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

our $shucks;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

use POSIX ":sys_wait_h"; # for nonblocking read

my %children;

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

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

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

Вот пример:

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

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

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

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

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

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

#!/usr/bin/perl

use v5.36;

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

$| = 1;

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

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

code();

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

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

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

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

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

Длительно выполняемые операторы

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Именованный канал (часто называемый FIFO) — это старый механизм 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 (my $fh, ">", $FIFO) || die "can't open $FIFO: $!";
    print $fh "John Smith (smith\@host.org)\n", `fortune -s`;
    close($fh)                || die "can't close $FIFO: $!";
    sleep 2;                # to avoid dup signals
}

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

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

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

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

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

Обратите внимание, что эти операции являются полными Unix-fork, что означает, что они могут быть неправильно реализованы на всех «чужих» системах. См. "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: $!";

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

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

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

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

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

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

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

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

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

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

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

use POSIX "setsid";

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

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

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

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

Ещё один интересный подход к межпроцессной связи (IPC) — сделать вашу программу многопроцессной и организовать взаимодействие между её процессами. Двухаргументная форма функции open() примет в качестве аргумента файл, который может быть "-|" или "|-", чтобы выполнить очень интересную операцию: она раздвоит (fork) дочерний процесс, подключенный к файловому дескриптору, который вы открыли. Дочерний процесс выполняет ту же программу, что и родительский. Это полезно для безопасного открытия файла при работе под предполагаемым 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() это просто, но вы не можете безопасно использовать открытие канала с помощью pipe или обратных кавычек. Это связано с тем, что нет способа помешать оболочке получить ваши аргументы. Вместо этого используйте более низкий уровень управления, чтобы напрямую вызвать exec().

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

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() больше трёх, это раздвоение (fork) команды 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|: $!";

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

Избегание тупиковых ситуаций с каналами

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

my $proto = getprotobyname("tcp");

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

logmsg "server started on port $port";

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

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

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

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

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

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

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

my $proto = getprotobyname("tcp");

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

logmsg "server started on port $port";

my $waitedpid = 0;

use POSIX ":sys_wait_h";
use Errno;

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

$SIG{CHLD} = \&REAPER;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Клиенты и серверы 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
use v5.36;
use Socket;

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

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

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

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

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

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

logmsg "server started on $NAME";

my $waitedpid;

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

$SIG{CHLD} = \&REAPER;


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

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

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

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

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

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

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

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

Клиенты TCP с IO::Socket

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

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

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

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

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

Wed May 14 08:40:46 MDT 1997

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

Proto

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

PeerAddr

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

PeerPort

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

Клиент Webget

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

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

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

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

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

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

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

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

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

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

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

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

Вот код:

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

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

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

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

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

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

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

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

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

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

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

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

Proto

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

LocalPort

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

Listen

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

Reuse

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

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

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

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

Вот код.

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

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

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

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

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

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

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

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

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

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

my $SECS_OF_70_YEARS = 2_208_988_800;

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

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

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

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

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

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

SysV IPC

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

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

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

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

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

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

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

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

use IPC::SysV qw(IPC_CREAT);

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

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

# create a semaphore

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

ПРИМЕЧАНИЯ

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

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

ОШИБКИ

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

АВТОР

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

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

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

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

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

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