perlipc

СОДЕРЖАНИЕ

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

ИМЯ

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

ОПИСАНИЕ

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

Сигналы

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

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

our $shucks;

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

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

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

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

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

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

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

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

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

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

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

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

Perl 5.8.0 и более поздние версии избегают этих проблем, "откладывая" сигналы. То есть, когда ядро доставляет сигнал процессу, устанавливается флаг, и обработчик возвращается немедленно. Затем в стратегические "безопасные" моменты в интерпретаторе 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)

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

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

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

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

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

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

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

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

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

    # next line blocks till there's a reader
    open (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, что означает, что они могут быть некорректно реализованы на всех системах. См. "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 из-за двойной вилки, подробнее см. ниже.

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

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

use POSIX "setsid";

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

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

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

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

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

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

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

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

Еще одно распространённое применение этого конструкта — выполнение чего-либо без вмешательства оболочки. С функцией system() это просто, но вы не можете безопасно использовать открытие канала с помощью 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
}

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

В частности, если вы открыли канал с использованием 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|: $!";

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

Избегание тупиков с pipe

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

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

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

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

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

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

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

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

Если вам действительно нужно, вы можете использовать стандартную open2() из модуля IPC::Open2 для захвата обоих концов. В модуле 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. Возможно, вы сможете сделать ещё больше в зависимости от вашей системы.

Перл-функции для работы с сокетами имеют те же названия, что и соответствующие системные вызовы в 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, вы, вероятно, будете в порядке.

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

#!/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);
}

Клиенты и серверы 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 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-домена вместо более простого именованного канала? Потому что именованный канал не предоставляет сеансов. Вы не можете отличить данные одного процесса от данных другого. С программированием сокетов вы получаете отдельный сеанс для каждого клиента; вот почему accept() принимает два аргумента.

Например, предположим, что у вас есть долго работающий демонический сервер базы данных, к которому вы хотите предоставить доступ из Web, но только если они проходят через 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 книги «Вельблюд».

Вот код.

#!/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, 2-е издание, том 1» У. Ричарда Стивенса (издательство Prentice-Hall). Большинство книг по сетевому программированию рассматривают эту тему с точки зрения программиста на C; перевод на Perl предоставляется как упражнение для читателя.

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

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