perlipc - межпроцессное взаимодействие Perl (сигналы, fifos, pipes, безопасные подпроцессы, сокеты и семафоры)
Основные возможности межпроцессного взаимодействия (IPC) в Perl основаны на старых добрых юниксовых сигналах, именованных каналах (names pipes), открытии каналов (pipe opens), сокетах Беркли и вызовах SysV IPC. Каждый из этих способов используется в несколько различных ситуациях.
В Perl используется простая модель обработки сигналов: хэш %SIG содержит имена или ссылки на определенные пользователем обработчики сигналов. Эти обработчики вызываются с аргументом - именем сигнала, вызвавшего срабатывание обработчика. Сигналы могут возникать из-за действий пользователя, например, после нажатия control-C или control-Z, посылаться другим процессом или вызываться автоматически ядром при возникновении особых событий: завершения дочернего процесса, переполнения стека или превышения лимита на объем файла вашим процессом.
Например, чтобы перехватить сигнал прерывания (INT), напишите такой обработчик:
sub catch_zap {
my $signame = shift;
$shucks++;
die "Кто-то прислал мне сигнал SIG$signame";
}
$SIG{INT} = 'catch_zap'; # может не сработать в модулях
$SIG{INT} = \&catch_zap; # лучший способ
В Perl версий до 5.7.3 необходимо совершать как можно меньше действий в обработчике сигнала; в общем случае устанавливается глобальная переменная и затем вызывается исключение. Причиной такого поведения является то, что в большинстве систем библиотеки не реентерабельны (re-entrant); в частности, таковыми являются функции выделения памяти и ввода/вывода. Это означает, что если вы будете делать все что угодно в обработчике, это может теоретически привести к сбоям памяти с последующим core dump - смотрите Задержанные (Deferred) сигналы (Безопасные сигналы) ниже.
Названия сигналов совпадают с выдаваемыми командой kill -l
в вашей системе, или вы можете получить их из модуля Config. Вот как заполнить
список @signame, проиндексированный по номерам для получения имени и
таблицу %signo, проиндексированную по именам для получения номера:
use Config;
defined $Config{sig_name} || die "Нет сигналов?";
foreach $name (split(' ', $Config{sig_name})) {
$signo{$name} = $i;
$signame[$i] = $name;
$i++;
}
Теперь, чтобы проверить, одинаковы ли сигналы 17 и SIGALRM, проделайте следующее:
print "сигнал #17 = $signame[17]\n";
if ($signo{ALRM}) {
print "SIGALRM - это сигнал #$signo{ALRM}\n";
}
Вы можете указать строки 'IGNORE' или 'DEFAULT'
в качестве обработчиков сигналов, в этом случае Perl будет пытаться
отбросить сигнал или совершить действия по умолчанию.
На большинстве Unix платформ сигнал CHLD (иногда также
называемый CLD) обеспечивает специальное поведение, когда
обработчик установлен в 'IGNORE'.
Установка $SIG{CHLD} в 'IGNORE' на таких платформах
приводит к тому, что процессы-зомби (zombie) не создаются, если родительский
процесс не вызывает wait() для этих дочерних процессов (т.е.
дочерние процессы автоматически завершаются).
Вызов wait(), когда $SIG{CHLD} установлен в
'IGNORE' на таких платформах обычно возвращает -1.
Некоторые сигналы не могут быть ни перехвачены, ни проигнорированы, это сигналы KILL и STOP (но не TSTP). Одним из способов временного игнорирования сигналов является использование оператора local(), предыдущее значение будет автоматически восстановлено при выходе из блока. (Помните, что значения, указанные в операторе local() "наследуются" функциями, вызываемыми из блока.)
sub precious {
local $SIG{INT} = 'IGNORE';
&more_functions;
}
sub more_functions {
# прерывания все еще игнорируются...
}
Отрицательный идентификатор процесса при посылке сигнала означает, что сигнал посылается всей группе процессов Unix. Этот код посылает сигнал hang-up всем процессам в текущей группе процессов (и устанавливает $SIG{HUP} в IGNORE, чтобы не завершить самого себя):
{
local $SIG{HUP} = 'IGNORE';
kill HUP => -$$;
# интересная запись для: kill('HUP', -$$)
}
Также интересен сигнал с номером ноль. Его посылка не производит реальных воздействий на дочерний процесс, но проверяет, существует ли процесс и не сменил ли он свой UID.
unless (kill 0 => $kid_pid) {
warn "что-то плохое случилось с $kid_pid";
}
Когда сигнал с номером ноль посылается процессу, чей UID не совпадает
с таковым посылающего процесса, происходит ошибка, т.к. у вас отсутсвуют
права на передачу сигнала, даже если процесс существует. Вы можете определить
причину ошибки, воспользовавшись %!.
unless (kill 0 => $pid or $!{EPERM}) {
warn "похоже $pid мертв";
}
Вы можете назначить анонимную функцию в качестве простого обработчика сигнала:
$SIG{INT} = sub { die "\nOutta here!\n" };
Существует проблема для более сложных обработчиков сигналов, которым требуется переустановить самих себя. Т.к. механизм сигналов в Perl сейчас базируется на функции signal(3) из библиотеки C, у вас могут возникнуть проблемы в системах, где эта функция "сломана", так происходит в старых ненадежных SysV, более новые BSD и POSIX ведут себя корректнее. Поэтому, для пущей безопасности, пишут обработчики сигналов следующим образом:
sub REAPER {
$waitedpid = wait;
# нехороший sysV: он заставляет нас не только переустанавливать
# обработчик, но и помещать эти действия после wait
$SIG{CHLD} = \&REAPER;
}
$SIG{CHLD} = \&REAPER;
# теперь можно разветвлять процесс...
или лучше так:
use POSIX ":sys_wait_h";
sub REAPER {
my $child;
# Если второй дочерний процесс завершится, когда мы будем находиться
# внутри обработчика, вызванного завершением первого дочернего процесса,
# мы не получим второй сигнал. Поэтому здесь может образоваться
# цикл или мы получим дочерний процесс-зомби. И в следующий раз,
# при одновременном завершении дочерних процессов, мы получим еще
# одного зомби. И т.д.
while (($child = waitpid(-1,WNOHANG)) > 0) {
$Kid_Status{$child} = $?;
}
$SIG{CHLD} = \&REAPER; # снова нехороший sysV
}
$SIG{CHLD} = \&REAPER;
# теперь можно разветвлять процесс...
Обработка сигналов также используется для организации задержек (timeouts)
в Unix, в надежно защищенном блоке eval{} устанавливается
обработчик сигнала alarm и настраивается посылка этого сигнала через несколько
секунд. Затем пытаемся выполнить блокирующую операцию, если она завершается
успешно, выключаем "будильник" до выхода из блока eval{}. Если
блокирующая операция не завершается вовремя, используем die(), чтобы выйти из
блока, аналогично longjmp() или throw() в других языках программирования.
Вот пример:
eval {
local $SIG{ALRM} = sub { die "alarm clock restart" };
alarm 10;
flock(FH, 2); # блокирующая операция, запрос блокировки на запись
alarm 0;
};
if ($@ and $@ !~ /alarm clock restart/) { die }
Если операция не завершается вовремя в system() или qx(), весьма вероятно, что этот метод приведет к возникновению зомби. Если это важно для вас, вам придется использовать fork() и exec() и принудительно завершать "заблудившиеся" дочерние процессы.
Для более сложной обработки сигналов вам стоит рассмотреть стандартный модуль POSIX. К сожалению, документация по нему почти полностью отсутствует, но в файле t/lib/posix.t из дистрибутива исходников Perl имеется несколько примеров.
Процесс, который обычно запускается при загрузке системы и завершается
при завершении работы системы, называется демоном (daemon - Disk And Execution
MONitor). Если у демона имеется конфигурационный файл, который изменяется
после запуска процесса, должен существовать способ дать указание процессу
перечитать свой конфигурационный файл без остановки процесса. Многие демоны
предоставляют такой механизм через обработчик сигнала SIGHUP.
Когда вы хотите заставить демона перечитать файл, вы просто посылаете ему
сигнал SIGHUP.
Не все платформы автоматически переустанавливают свой ("родной" - native)
обработчик сигнала после доставки сигнала. Это означает, что обработчик
срабатывает только один раз после посылки сигнала. Решением этой проблемы
будет использование обработчиков сигналов POSIX, если они
доступны, их поведение более предсказуемо.
Следующий пример реализует простого демона, который перезапускает сам себя
после каждого получения сигнала SIGHUP. Основной код расположен
в процедуре code(), которая просто печатает некоторую отладочную
информацию, этот код следует заменить реальными командами.
#!/usr/bin/perl -w
use POSIX ();
use FindBin ();
use File::Basename ();
use File::Spec::Functions;
$|=1;
# делаем демона кросс-платформенным, так что exec всегда вызывает
# скрипт с правильным путем, независимо от того, как скрипт
# был запущен
my $script = File::Basename::basename($0);
my $SELF = catfile $FindBin::Bin, $script;
# POSIX корректно демаскирует sigprocmask
my $sigset = POSIX::SigSet->new();
my $action = POSIX::SigAction->new('sigHUP_handler',
$sigset,
&POSIX::SA_NODEFER);
POSIX::sigaction(&POSIX::SIGHUP, $action);
sub sigHUP_handler {
print "получен SIGHUP\n";
exec($SELF, @ARGV) or die "Невозможно перезапустить: $!\n";
}
code();
sub code {
print "PID: $$\n";
print "ARGV: @ARGV\n";
my $c = 0;
while (++$c) {
sleep 2;
print "$c\n";
}
}
__END__
Именованные каналы (часто упоминаемые как FIFO) - это старый механизм межпроцессного взаимодействия Unix, для взаимодействия в пределах одной машины. Они работают также как обычные объединенные анонимные каналы (pipes), за исключением того, что процессы взаимодействуют с использованием имени файла и каналы не могут быть связанными (related).
Для создания именованного канала используется команда Unix mknod(1) или, в некоторых системах, mkfifo(1). Эта команда может располагаться и не по обычному пути (path).
# system возвращает 0 при успешном выполнении, поэтому && а не ||
#
$ENV{PATH} .= ":/etc:/usr/etc";
if ( system('mknod', $path, 'p')
&& system('mkfifo', $path) )
{
die "mk{nod,fifo} $path failed";
}
Именованные каналы удобны, когда вы хотите взаимодействовать с независимым процессом. Когда вы открываете fifo, программа блокируется, пока не появится кто-либо на другом конце канала.
Для примера пусть у нас имеется файл .signature в качестве именованного канала с программой на Perl на другом конце канала. Теперь каждый раз, когда какая-нибудь программа (отправитель почты, программа для чтения новостей, finger и др.) попытается прочесть этот файл, она будет заблокирована, а наша программа выдаст новую подпись (signature). Мы будем использовать тест на существование файла-канала -p, чтобы определить, не удалил ли кто-нибудь (или что-нибудь) случайно наш fifo.
chdir; # идем в домашний каталог
$FIFO = '.signature';
$ENV{PATH} .= ":/etc:/usr/games";
while (1) {
unless (-p $FIFO) {
unlink $FIFO;
system('mknod', $FIFO, 'p')
&& die "невозможно выполнить mknod $FIFO: $!";
}
# следующая строка блокируется, пока нет читателя
open (FIFO, "> $FIFO") || die "невозможно записать в $FIFO: $!";
print FIFO "Джон Смит (smith\@host.org)\n", `fortune -s`;
close FIFO;
sleep 2; # чтобы избежать двойного срабатывания
}
Когда вы создаете код, работающий с сигналами на Perl до версии 5.7.3, вам придется столкнуться с двумя опасными вещями. Первое, многие функции системных библиотек нереентерабельны. Если сигнал прерывает выполнение такой функции (например malloc(3) или printf(3)), а ваш обработчик сигнала затем вызывает ту же функцию снова, поведение программы становится непредсказуемым - часто приводит к core dump. Второе, Perl сам по себе нереентерабелен на низком уровне. Когда сигнал приходит в момент, когда Perl изменяет свои внутренние структуры данных, поведение программы также может стать непредсказуемым.
Зная об этих особенностях, можно использовать два подхода: параноидальный
или прагматичный. Параноидальный подход заключается в том, чтобы совершать
как можно меньше действий в обработчике сигнала. Установите значение
существующей целой переменной, у которой уже определено значение, и выходите.
Это не поможет, если в данный момент выполняется медленный системный вызов,
который тут же перезапустится. Вам придется использовать die,
чтобы выпрыгнуть (longjump(3)) из обработчика. И это еще не самый
параноидальный подход, настоящие параноики избегают использования
die в обработчике, потому что система в этом случае им не
подчиняется (is out to get you). Прагматичный подход утверждает:
"Я знаю о риске, но предпочитаю делать так, как мне удобнее", в обработчике
сигнала совершаются все необходимые действия, а разработчику приходится быть
готовым получать core dumps снова и снова.
В Perl 5.7.3 и более поздних, чтобы избежать подобных проблем, сигналы "задерживаются" (deffered) - это означает, что когда сигнал приходит к процессу (коду на C, который реализует Perl) от системы, устанавливается флаг, и обработчик сразу же завершается. Затем, в "безопасной" точке внутри интерпретатора Perl (например при выполнении нового оператора) проверяется состояние флага и выполняется обработчик уровня Perl из хэша %SIG. Схема "задержания" сигналов позволяет разрабатывать более гибкие обработчики сигналов, т.к. при вызове обработчика мы знаем, что интерпретатор Perl находится в безопасном состоянии, и сейчас не осуществляется вызова функции системной библиотеки. Однако реализация подобной схемы различается от прыдыдущих версий Perl следующим образом:
Если сигнал приходит при выполнении длительного оператора (например, вычислении регулярного выражения по очень большой строке), сигнал не будет виден до завершения оператора, т.к. интерпретатор Perl просматривает флаги сигналов только перед началом выполнения нового оператора,
Когда поступает сигнал (например, прерывание INT control-C) операционная
система прекращает операции ввода-вывода, такие как read
(используется для реализации оператора Perl <>). В старом Perl
обработчик вызывался немедленно (и т.к. вызов read "безопасен",
все работало нормально). С "задержанными" сигналами обработчик не вызывается
немедленно, и, т.к. Perl использует системную библиотеку stdio,
эта библиотека может перезапустить read не передавая управление
Perl, а значит не давая шанса вызвать обработчик из %SIG. Если так происходит
в вашей системе, используйте уровень :perlio для ввода-вывода
- как минимум на тех дескрипторах, операции с которыми вы бы хотели прерывать
по сигналам. (Уровень :perlio проверяет флаги сигналов и
вызывает обработчики из %SIG до завершения операции ввода-вывода.)
Некоторые функции сетевых библиотек, например 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" }))
or die "Ошибка в установке обработчика SIGALRM: $!\n";
В системах, которые поддерживают такие вызовы, старые версии Perl
использовали флаг SA_RESTART при установке обработчиков %SIG. Это означало,
что рестартуемые системные вызовы должны продолжаться, а не завершаться при
поступлении сигнала. Для того, чтобы быстро доставить задержанные сигналы,
Perl 5.7.3 и более поздние не используют SA_RESTART. В результате
рестартуемые системные вызовы могут вызывать ошибку ($! устанавливается в
EINTR) в местах, где раньше они работали успешно.
По умолчанию уровень :perlio будет повторять вызовы
read, write и close как описано выше,
а прерванные вызовы wait и waitpid повторяются
всегда.
Некоторые сигналы, например SEGV, ILL, BUS, возникают от сбоев виртуальной памяти или других "сбоев". Обычно они фатальны и с ними мало что можно сделать на уровне обработчика Perl. (Особенно это было небезопасно в старой схеме обработки сигналов). Однако в новой схеме, как описано выше, если в %SIG установлен обработчик, просто устанавливается флаг и обработчик завершается. Это может привести к тому, что операционная система будет пытаться выполнить ошибочную машинную команду снова и - т.к. ничего не изменилось - сигнал возникнет снова. В результате получается "цикл". В будущем механизм сигналов Perl возможно будет изменен, чтобы избежать этого, - возможно просто будет запрещено устанавливать обработчики %SIG на эти сигналы. (Какие именно сигналы - зависит от операционной системы.)
В некоторых операционных системах обработчики некоторых сигналов должны
"что-то сделать" прежде чем завершиться. Например, сигнал CHLD или CLD,
который показывает, что дочерний процесс завершился. В некоторых операционных
системах обработчик сигнала необходим для ожидания (вызов wait)
полного завершения дочернего процесса. В таких системах схема задержанных
сигналов не будет работать для этих сигналов (в них не работает
wait). Снова получается сбой в виде цикла, т.к. операционная
система снова генерирует сигнал, т.к. существуют дочерние процессы,
недождавшиеся (un-waited-for) корректного завершения.
Если вы хотите использовать старый механизм обработки сигналов, несмотря
на возможное повреждение памяти, присвойте переменной окружения
PERL_SIGNALS значение "unsafe" (такая возможность
появилась в Perl 5.8.1).
Базовый оператор Perl open() может также использоваться для однонаправленного межпроцессного взаимодейтвия путем помещения символа канала (|) перед или после значения второго агрумента open(). Вот как запустить дочерний процесс, в который необходимо писать:
open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
|| die "невозможно создать процесс: $!";
local $SIG{PIPE} = sub { die "канал разорван" };
print SPOOLER "что-нибудь\n";
close SPOOLER || die "плохой буфер: $! $?";
А вот как создать дочерний процесс, из которого необходимо читать:
open(STATUS, "netstat -an 2>&1 |")
|| die "невозможно создать процесс: $!";
while (<STATUS>) {
next if /^(tcp|udp)/;
print;
}
close STATUS || die "плохой netstat: $! $?";
Умный программист, если будет уверен, что некоторая программа является скриптом на Perl, который ожидает имя файла в @ARGV, сможет написать что-то вроде этого:
% program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
и независимо от того, из чьей оболочки это будет запущено, программа на Perl будет читать из файла f1, процесса cmd1, стандартного ввода (файл tmpfile в данном случае), файла f2, команды cmd2, и, наконец, из файла f3. Неплохо, правда?
Вы могли заметить, что обратные кавычки дают такой же эффект, что и открытие канала для чтения:
print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
die "плохой netstat" if $?;
Если не углубляться в детали, это действительно так, но гораздо более эффективно обрабатывать файл построчно или по записям, т.к. при этом вам не требуется держать весь файл в памяти. Также при открытии канала вы можете более точно контролировать весь процесс, вы можете принудительно завершить дочерний процесс, если захотите.
Внимательно проверяйте значения, возвращаемые и open(), и close(). Если вы пишите в канал, вам также следует перехватывать SIGPIPE. Иначе, представьте, что происходит, когда вы открываете канал с командой, которая не существует: open() почти всегда завершается успешно (он только отражает успешность fork()), но интересно, когда ваш вывод завершиться с ошибкой? Perl не знает, работает ли команда, потому что она фактически запущена в другом процессе, где вызов exec() может быть неудачным. И если чтение из несуществующей команды сразу возвращает конец файла, запись в несуществующую команду вызывает сигнал, который лучше отловить. Смотрите:
open(FH, "|bogus") or die "ошибка fork: $!";
print FH "bang\n" or die "ошибка write: $!";
close FH or die "ошибка close: $!";
Ошибки не возникнет до вызова close, хотя на самом деле о возникновении ошибки говорит сигнал SIGPIPE. Чтобы его поймать, можете поступить так:
$SIG{PIPE} = 'IGNORE';
open(FH, "|bogus") or die "ошибка fork: $!";
print FH "bang\n" or die "ошибка write: $!";
close FH or die "ошибка close: status=$?";
И основной процесс и все дочерние процессы, порожденные им, совместно используют одни и те же дескрипторы STDIN, STDOUT и STDERR. Когда несколько процессов пытаются воспользоваться или одновременно, могут происходить странные вещи. Вы можете также закрыть или переоткрыть файловые дескрипторы для дочернего процесса. Вы можете сделать это, открыв канал с помощью open(), но в некоторых системах это приведет к тому, что дочерний процесс не сможет пережить родительский.
Вы можете запустить команду в фоне следующим образом:
system("cmd &");
STDOUT и STDERR команды (и возможно STDIN, в зависимости от оболочки) будут теми же, что и у родительского процесса. Здесь нет необходимости перехватывать SIGCHLD, потому что имеет место двойное ветвление (double-fork) процесса (подробности смотрите ниже).
В некоторых случаях (например запуск процесса-сервера) необходимо полностью отделить дочерний процесс от родительского. Это часто называется демонизацией. Хороший демон также делает chdir() на корневой каталог (чтобы не мешать размонтированию файловой системы, содержащей каталог, из которого он был запущен) и перенаправляет стандартные файловые дескрипторы на /dev/null (чтобы случайный вывод не забивал терминал пользователя).
use POSIX 'setsid';
sub daemonize {
chdir '/' or die "не могу сменить каталог на /: $!";
open STDIN, '/dev/null' or die "не могу читать /dev/null: $!";
open STDOUT, '>/dev/null'
or die "не могу писать в /dev/null: $!";
defined(my $pid = fork) or die "не могу создать процесс: $!";
exit if $pid;
setsid or die "не могу начать новую сессию: $!";
open STDERR, '>&STDOUT' or die "не могу продублировать stdout: $!";
}
fork() вызывается до setsid() чтобы быть уверенным, что мы не являемся
лидером группы процессов (setsid() вызывает ошибку, если процесс - лидер).
Если ваша система не поддерживает функцию setsid(), откройте /dev/tty
и используйте TIOCNOTTY ioctl(). Подробности смотрите в
tty(4).
Пользователям не-Unix систем следует проверить модуль Ваша_ОС::Process для остальных решений.
Другим интересным подходом к межпроцессному взаимодействию является
создание одной многопроцессной программы, которая взаимодействует сама с собой.
Функция open() принимает в качестве аргумента "-|" или
"|-", при этом происходит интересная вещь: создается дочерний
процесс, связанный с дескрипторов файла, который вы открываете. Дочерний
процесс выполняет ту же программу, что и родительский. Это может быть полезно,
например, для безопасного открытия файла, когда программа выполняется под
вымышленными UID или GID. Если вы открываете канал в минус, вы можете
писать в открытый дескриптор файла, а дочерний процесс получит записываемые
данные на свой STDIN. Если вы открываете канал из минуса, вы можете
читать из открытого файлового дескриптора, в то время как дочерний процесс
пишет в свой STDOUT.
use English '-no_match_vars';
my $sleep_count = 0;
do {
$pid = open(KID_TO_WRITE, "|-");
unless (defined $pid) {
warn "невозможно создать процесс: $!";
die "принудительно выходим" if $sleep_count++ > 6;
sleep 10;
}
} until defined $pid;
if ($pid) { # родительский процесс
print KID_TO_WRITE @some_data;
close(KID_TO_WRITE) || warn "дочерний процесс завершился $?";
} else { # дочерний процесс
($EUID, $EGID) = ($UID, $GID); # только для suid программ
open (FILE, "> /safe/file")
|| die "невозможно открыть /safe/file: $!";
while (<STDIN>) {
print FILE; # дочерний STDIN - это родительский KID
}
exit; # не забудьте это
}
Другим общим случаем использования этой конструкции является выполнение чего-либо без вмешательства оболочки. С вызовом system() это вмешательство явно видно, но у вас не получится спокойно использовать и открытие каналов или обратные кавычки. Так происходит потому что нет способа заставить оболочку не разбирать агрументы запускаемых программ. Вместо этих конструкций используйте низкоуровневый подход - напрямую вызывайте exec().
Вот безопасная замена обратных кавычек или открытия канала для чтения:
# добавьте обработку ошибок, как было показано выше
$pid = open(KID_TO_READ, "-|");
if ($pid) { # родительский процесс
while (<KID_TO_READ>) {
# делаем что-нибудь полезное
}
close(KID_TO_READ) || warn "дочерний процесс завершился $?";
} else { # дочерний процесс
($EUID, $EGID) = ($UID, $GID); # только для suid
exec($program, @options, @args)
|| die "невозможно выполнить программу: $!";
# здесь уже ничего не выполняется
}
А вот открытие безопасного канала за запись:
# добавьте обработку ошибок, как было показано выше
$pid = open(KID_TO_WRITE, "|-");
$SIG{PIPE} = sub { die "упс, канал с $program сломался" };
if ($pid) { # родительский процесс
for (@data) {
print KID_TO_WRITE;
}
close(KID_TO_WRITE) || warn "дочерний процесс завершился $?";
} else { # дочерний процесс
($EUID, $EGID) = ($UID, $GID);
exec($program, @options, @args)
|| die "невозможно выполнить программу: $!";
# здесь уже ничего не выполняется
}
Начиная с Perl 5.8.0 можно использовать списковую форму open
для открытия каналов: следующий пример
open KID_PS, "-|", "ps", "aux" or die $!;
запускает команду ps(1) (оболочка не запускается, у open() больше трех
аргументов) и считывает ее стандартный вывод через дескриптор
KID_PS. Соотвествующий систаксис для чтения из команды через
канал ("|-" вместо "-|") также поддерживается.
Все эти операции являются ветвлением (fork) Unix, это означает, что они могут быть некорректно реализованы на других системах. Кроме того, это не истинная многопоточность (multithreading). Если вы хотите узнать больше о потоках, смотрите файлы модулей, приведенные ниже в секции СМОТРИТЕ ТАКЖЕ.
Если так удобно реализовано однонаправленное взаимодействие, что у нас с двусторонним взаимодействием? Такой очевидный прием на практике не работет:
open(PROG_FOR_READING_AND_WRITING, "| какая-то программа |")
и если вы забудете указать use warnings или флаг -w, то
вы пропустите диагностическое сообщение:
Can't do bidirectional pipe at -e line 1.
Невозможно создать двунаправленный канал
Если вам действительно необходим двунаправленный канал, вы можете использовать стандартную библиотечную функцию open2(), чтобы перехватывать ввод и вывод программы. Существует также функция open3() для трехнаправленного ввода/вывода, таким образом вы можете перехватывать STDERR дочернего процесса, но использование этой функции требует последующего неуклюжего цикла select() и не позволяет пользоваться обычными операциями ввода Perl.
Если вы посмотрите исходный код, вы увидите, что open2() использует низкоуровневые примитивы, такие как Unix вызовы pipe() и exec(), для создания всех соединений. Хотя использование этой функции может быть несколько более эффективным, чем socketpair(), она не является такой уж переносимой. Маловероятно, что функции open2() и open3() будут работать где-либо, кроме Unix систем или систем, претендующих на совместимость с POSIX.
Вот пример использования open2():
use FileHandle;
use IPC::Open2;
$pid = open2(*Reader, *Writer, "cat -u -n" );
print Writer "stuff\n";
$got = <Reader>;
Здесь имеется проблема, буферизация Unix действительно может испортить
вам день. Даже если ваш дескриптор Writer является auto-flushed
дескриптором, и процесс на другом конце получает свои данные своевременно,
обычно у вас нет никаких средств заставить его возвращать данные также
своевременно. Поэтому мы указали cat флаг -u, чтобы сделать
вывод небуферизованным. Однако очень мало команд Unix разработано для
работы с каналами (pipes), поэтому такой код редко срабатывает, только если
вы сами не напишите программу, которая будет работать на другом конце
двунаправленного канала.
Решением является использование нестандартной библиотеки Comm.pl. Она использует pseudo-ttys, чтобы сделать поведение вашей программы более корректным:
require 'Comm.pl';
$ph = open_proc('cat -n');
for (1..10) {
print $ph "строка\n";
print "получили ответ ", scalar <$ph>;
}
Таким образом, у вас нет необходимости в доступе к исходному коду используемой программы. Библиотека Comm также содержит функции expect() и interact(). Вы можете найти библиотеку (и, надеемся, ее преемника IPC::Chat) в ближайтем архиве CPAN, как указано в разделе СМОТРИТЕ ТАКЖЕ ниже.
Более новый модуль Expect.pm из CPAN также предназначен для подобных вещей. Этот модуль требует для работы два других модуля из CPAN: IO::Pty и IO::Stty. Он настраивает псевдо-терминалы для взаимодействия с программами, которые работают с драйвером терминального устройства. Если в вашей системе такое поддерживается - этот модуль будет лучшим выбором.
Если хотите, можете объединить низкоуровневые pipe() и fork() вручную. В этом примере происходит взаимодействие только с самим собой, но вы можете переоткрыть соответствующие дескрипторы для STDIN и STDOUT, и вызвать другой процесс.
#!/usr/bin/perl -w
# pipe1 - двусторонее взаимодействие, использующее два канала (pipe)
# двусторонне приветствие
use IO::Handle; # тысячи строк кода только для autoflush :-(
pipe(PARENT_RDR, CHILD_WTR); # XXX: ошибка выполнения?
pipe(CHILD_RDR, PARENT_WTR); # XXX: ошибка выполнения?
CHILD_WTR->autoflush(1);
PARENT_WTR->autoflush(1);
if ($pid = fork) {
close PARENT_RDR; close PARENT_WTR;
print CHILD_WTR "Родитель с Pid $$ посылает это\n";
chomp($line = <CHILD_RDR>);
print "Родитель с Pid $$ только что прочитал это: `$line'\n";
close CHILD_RDR; close CHILD_WTR;
waitpid($pid,0);
} else {
die "ошибка fork: $!" unless defined $pid;
close CHILD_RDR; close CHILD_WTR;
chomp($line = <PARENT_RDR>);
print "Дочка с Pid $$ только что прочитала это: `$line'\n";
print PARENT_WTR "Дочка с Pid $$ посылает это\n";
close PARENT_RDR; close PARENT_WTR;
exit;
}
Но не обязательно делать два вызова pipe(). Если ваша система поддерживает вызов socketpair(), можно воспользоваться им.
#!/usr/bin/perl -w
# pipe2 - двусторонне взаимодействие, использующее socketpair
# "the best ones always go both ways"
# (лучшие всегда идут двумя путями ?)
use Socket;
use IO::Handle; # тысячи строк только ради autoflush :-(
# Мы используем AF_UNIX, потому что определенная в POSIX 1003.1g
# форма константы *_LOCAL, на многих машинах
# все еще отсутствует.
socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
or die "socketpair: $!";
CHILD->autoflush(1);
PARENT->autoflush(1);
if ($pid = fork) {
close PARENT;
print CHILD "Родитель с Pid $$ посылает это\n";
chomp($line = <CHILD>);
print "Родитель с Pid $$ только что прочел это: `$line'\n";
close CHILD;
waitpid($pid,0);
} else {
die "ошибка fork: $!" unless defined $pid;
close CHILD;
chomp($line = <PARENT>);
print "Дочка с Pid $$ только что прочитала это: `$line'\n";
print PARENT "Дочка с Pid $$ посылает это\n";
close PARENT;
exit;
}
Хотя использование сокетов не ограничивается операционными системами семейства Unix (например, WinSock на PC, а также некоторые библиотеки 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, все должно работать нормально.
Используйте сокеты Интернет, если вы хотите осуществлять клиент-серверное взаимодействие, которое может происходить с машинами за пределами вашей системы.
Вот простой TCP клиент использующий сокеты Интернет (Internet-domain sockets):
#!/usr/bin/perl -w
use strict;
use Socket;
my ($remote,$port, $iaddr, $paddr, $proto, $line);
$remote = shift || 'localhost';
$port = shift || 2345; # случайный порт
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "Нет порта" unless $port;
$iaddr = inet_aton($remote) || die "не хост: $remote";
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";
while (defined($line = <SOCK>)) {
print $line;
}
close (SOCK) || die "close: $!";
exit;
А вот соотвествующий сервер, с которым может общаться этот клиент. Мы выставляем значение адреса в INADDR_ANY, чтобы ядро могло выбрать нужный интерфейс на многоинтерфейсном хосте. Если вы хотите обслуживать конкретный интерфейс (например, внешний интерфейс шлюза или файервола), вам следует записать на это место ваш реальный адрес.
#!/usr/bin/perl -Tw
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
my $EOL = "\015\012";
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $port = shift || 2345;
my $proto = getprotobyname('tcp');
($port) = $port =~ /^(\d+)$/ or die "неверный порт";
socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "сервер запущен на порту $port";
my $paddr;
$SIG{CHLD} = \&REAPER;
for ( ; $paddr = accept(Client,Server); close Client) {
my($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "соединение с $name [",
inet_ntoa($iaddr), "]
с порта $port";
print Client "Привет, далекий $name, сейчас ",
scalar localtime, $EOL;
}
А вот многопоточная версия. Она является многопоточной потому что, как большинство обычных серверов, порождает вторичный сервер для обслуживания запроса клиента, в то время как главный сервер может быстро вернуться к обслуживанию нового клиента.
#!/usr/bin/perl -Tw
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
my $EOL = "\015\012";
sub spawn; # предварительное объявление
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $port = shift || 2345;
my $proto = getprotobyname('tcp');
($port) = $port =~ /^(\d+)$/ or die "неверный порт";
socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "сервер запущен на порту $port";
my $waitedpid = 0;
my $paddr;
use POSIX ":sys_wait_h";
sub REAPER {
my $child;
while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
logmsg "завершился $waitedpid" . ($? ? " код возврата $?" : '');
}
$SIG{CHLD} = \&REAPER; # нехороший sysV
}
$SIG{CHLD} = \&REAPER;
for ( $waitedpid = 0;
($paddr = accept(Client,Server)) || $waitedpid;
$waitedpid = 0, close Client)
{
next if $waitedpid and not $paddr;
my($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "соединение с $name [",
inet_ntoa($iaddr), "]
с порта $port";
spawn sub {
$|=1;
print "Привет, далекий $name, сейчас ", scalar localtime, $EOL;
exec '/usr/games/fortune' # XXX: неправильные окончания строк
or confess "невозможно выполнить fortune: $!";
};
}
sub spawn {
my $coderef = shift;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
logmsg "ошибка fork: $!";
return;
} elsif ($pid) {
logmsg "породили $pid";
return; # я - родитель
}
# иначе я дочерний процесс -- делаем, что надо
open(STDIN, "<&Client") || die "ошибка дублирования client в stdin";
open(STDOUT, ">&Client") || die "ошибка дублирования client в stdout";
## open(STDERR, ">&STDOUT") || die "ошибка дублирования stdout в stderr";
exit &$coderef();
}
Этот сервер порождает свою дочернюю версию с помощью fork() для каждого входящего запроса. Поэтому он может обработать сразу множество запросов, но такое поведение не всегда нужно. Даже если вы не будете делать fork(), функция listen() позволяет держать много незавершенных соединений. Ветвящиеся (forking) серверы должны особенно заботиться о своих завершенных дочерних процессах ("зомби" (zombies) в терминологии Unix), потому что иначе ваша таблица процессов быстро переполнится.
Мы советуем использовать флаг -T для дополнительной проверки (см. perlsec) даже если ваша программа не работает как setuid или setgid. Этот флаг следует устанавливать для серверов и других программ, действующих от чужого лица (например, CGI скриптов), т.к. это снижает риск, что кто-то из внешнего мира сможет навредить вашей системе.
Давайте посмотрим на другого TCP клиента. Он подключается к TCP службе "времени" на нескольких различных машинах и показывает, насколько их часы отличаются от часов системы, на которой он запущен.
#!/usr/bin/perl -w
use strict;
use Socket;
my $SECS_of_70_YEARS = 2208988800;
sub ctime { scalar localtime(shift) }
my $iaddr = gethostbyname('localhost');
my $proto = getprotobyname('tcp');
my $port = getservbyname('time', 'tcp');
my $paddr = sockaddr_in(0, $iaddr);
my($host);
$| = 1;
printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
foreach $host (@ARGV) {
printf "%-24s ", $host;
my $hisiaddr = inet_aton($host) || die "неизвестный хост";
my $hispaddr = sockaddr_in($port, $hisiaddr);
socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCKET, $hispaddr) || die "bind: $!";
my $rtime = ' ';
read(SOCKET, $rtime, 4);
close(SOCKET);
my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
printf "%8d %s\n", $histime - time, ctime($histime);
}
С Интернет (Internet-domain) клиентами и серверами все понятно, а как насчет локального взаимодействия? Хотя вы можете использовать те же схемы, иногда этого не хочется делать. Unix-domain сокеты локальны для хоста и часто используются для внутренней реализации каналов (pipes). В отличие от Интернет, Unix сокеты можно увидеть в файловой системе в выводе ls(1).
% ls -l /dev/log
srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
Вы можете проверить, сокет ли это, с помощью ключа проверки файлов -S:
unless ( -S '/dev/log' ) {
die "что-то не так в системе ведения журналов";
}
Вот простой Unix-domain клиент:
#!/usr/bin/perl -w
use Socket;
use strict;
my ($rendezvous, $line);
$rendezvous = shift || 'catsock';
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
while (defined($line = <SOCK>)) {
print $line;
}
exit;
А вот соответсвующий сервер. Вам не нужно беспокоиться о глупых окончаниях строк, потому что Unix-domain сокеты гарантированно работают на локальной машине и все должно работать нормально.
#!/usr/bin/perl -Tw
use strict;
use Socket;
use Carp;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
sub spawn; # предварительное объявление
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
my $NAME = 'catsock';
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname('tcp');
socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
unlink($NAME);
bind (Server, $uaddr) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "сервер запущен на $NAME";
my $waitedpid;
use POSIX ":sys_wait_h";
sub REAPER {
my $child;
while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
logmsg "завершен $waitedpid" . ($? ? " код возврата $?" : '');
}
$SIG{CHLD} = \&REAPER; # нехороший sysV
}
$SIG{CHLD} = \&REAPER;
for ( $waitedpid = 0;
accept(Client,Server) || $waitedpid;
$waitedpid = 0, close Client)
{
next if $waitedpid;
logmsg "соединение на $NAME";
spawn sub {
print "Привет, сейчас ", scalar localtime, "\n";
exec '/usr/games/fortune' or die "невозможно выполнить fortune: $!";
};
}
sub spawn {
my $coderef = shift;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
logmsg "ошибка fork: $!";
return;
} elsif ($pid) {
logmsg "породили $pid";
return; # я - родитель
}
# иначе я дочерний процесс - делаем, что надо
open(STDIN, "<&Client") || die "ошибка дублирования client в stdin";
open(STDOUT, ">&Client") || die "ошибка дублирования client в stdout";
## open(STDERR, ">&STDOUT") || die "ошибка дублирования stdout в stderr";
exit &$coderef();
}
Как видите, он очень похож на Интернет TCP сервер, фактически, вы используете те же функции - spawn(), logmsg(), ctime(), и REAPER(), которые в точности совпадают с одноименными функциями в другом сервере.
Так зачем вообще использовать Unix domain сокеты вместо более простых именованных каналов (named pipe)? Именованные каналы не позволяют оперировать сессиями. Вы не можете отличить данные одного процесса от данных другого. С помощью сокетов вы получаете различные сессии для различных клиентов: вот почему accept() принимает два аргумента.
Например, у вас имеется постоянно работающий демон сервера базы данных, вы хотите, чтобы ваши знакомые из Всемирной Паутины могли получить к нему доступ, но только когда они пройдут через CGI интерфейс. Вам нужна маленькая, простая CGI программа, которая только делает необходимые проверки и записывает в журнал то, что вы хотите, а затем работает как Unix-domain клиент и подключается к вашему личному серверу.
Для тех, кто предпочитает высокоуровневый интерфейс для программирования сокетов, модуль IO::Socket предоставляет объектно-ориентированный подход. IO::Socket включен в стандартный дистрибутив Perl начиная с версии 5.004. Если вы используете более раннюю версию Perl, просто возьмите IO::Socket из CPAN, там же вы можете найти модули, предоставляющие простой интерфейс для следующих систем: DNS, FTP, Ident (RFC 931), NIS и NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet и Time - это только несколько наименований.
Вот клиент, который устанавливает TCP соединение с сервисом "daytime" на порту 13 хоста с именем "localhost" и распечатывает все, что выдает сервер.
#!/usr/bin/perl -w
use IO::Socket;
$remote = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => "localhost",
PeerPort => "daytime(13)",
)
or die "невозможно подключиться к порту daytime на localhost";
while ( <$remote> ) { print }
Когда вы запустите эту программу, вы должны получить что-то вроде этого:
Wed May 14 08:40:46 MDT 1997
Вот что означают параметры, передаваемые конструктору new:
Proto
Название используемого протокола. В данном примере возвращаемый дескриптор сокета должен быть связан с TCP сокетом, т.к. нам необходимо потоковое соединение, которое во многом работает как старые добрые файлы. Не все сокеты бывают такого типа. Например, протокол UDP может использоваться для создания дейтаграммного сокета, предназначенного для передачи сообщений.
PeerAddr
Это имя или Интернет адрес удаленного хоста, на котором запущен сервер.
Можно указать длинное имя, например "www.perl.com", или адрес,
например "204.148.40.9". В демонстрационных целях мы
использовали специальное имя "localhost", которое должно всегда
соответствовать машине, на которой запущена программа. Соответствующий
Интернет адрес для локальной машины - это "127.1", вы вполне
можете использовать и его.
PeerPort
Это имя службы или номер порта, к которому мы хотим подключиться.
Мы можем использовать просто "daytime" на системах с правильно
сконфигурированным файлом системных служб [ПРИМЕЧАНИЕ: В Unix это файл
/etc/services], но в данном случае мы указали номер порта (13) в
скобках. Указание только номера порта тоже будет работать, но константные
значения нервируют осторожных программистов.
Заметьте, как значение, возвращаемое конструктором new,
используется как дескриптор файла в цикле while. Это то, что
называется косвенным (indirect) дескриптором файла - скалярная переменная,
содержащая дескриптор. Ее можно использовать так же как обычный дескриптор.
Например, вы можете прочитать одну строку:
$line = <$handle>;
все оставшиеся строки:
@lines = <$handle>;
послать строку данных:
print $handle "какие-то данные\n";
Вот простой клиент, который подключается к удаленному хосту и получает документ, а затем распечатывает все полученные документы. Этот клиент интереснее предыдущего, потому что он сам посылает данные на сервер прежде чем получить ответ сервера.
#!/usr/bin/perl -w
use IO::Socket;
unless (@ARGV > 1) { die "usage: $0 host document ..." }
$host = shift(@ARGV);
$EOL = "\015\012";
$BLANK = $EOL x 2;
foreach $document ( @ARGV ) {
$remote = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => $host,
PeerPort => "http(80)",
);
unless ($remote) { die "невозможно соединиться с http-демоном на $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.
Хорошо, все замечательно, если вы хотите послать одну команду и получить один ответ, но как насчет чего-то полностью интерактивного, чего-то вроде telnet? Вы должны написать строку, получить ответ, написать строку, получить ответ и т.д.
Этот клиент сложнее тех двух, что мы уже делали, но если ваша система
поддерживает мощный вызов fork, решение не будет тяжеловесным.
Когда вы установили соединение с каким-то сервисом, чтобы пообщаться с ним,
вызываем fork, чтобы клонировать наш процесс. У этих двух
идентичных процессов очень простая работа: родительский процесс копирует
все полученное из сокета на стандартный вывод, а дочерний процесс одновременно
копирует все из стандартного ввода в сокет. Добиться того же, используя один
процесс гораздо сложнее, потому что проще написать два процесса,
делающие одну вещь, чем один процесс, делающий две вещи. (Этот принцип
"сохранения простоты" (keep-it-simple), являющийся краеугольным камнем
философии Unix и разработки хороших программ, почему-то не распространяется
на другие системы.)
Вот код:
#!/usr/bin/perl -w
use strict;
use IO::Socket;
my ($host, $port, $kidpid, $handle, $line);
unless (@ARGV == 2) { die "usage: $0 host port" }
($host, $port) = @ARGV;
# создаем tcp соединение на указанный хост и порт
$handle = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $host,
PeerPort => $port)
or die "невозможно подключиться к порту $port на $host: $!";
$handle->autoflush(1); # чтобы вывод отправлялся сразу
print STDERR "[Подключились к $host:$port]\n";
# разделяем программу на два идентичных процесса
die "ошибка fork: $!" unless defined($kidpid = fork());
# блок if{} выполнится только в родительском процессе
if ($kidpid) {
# копируем сокет на стандартный вывод
while (defined ($line = <$handle>)) {
print STDOUT $line;
}
kill("TERM", $kidpid); # посылаем SIGTERM дочке
}
# блок else{} выполнится только в дочернем процессе
else {
# копируем стандартный ввод в сокет
while (defined ($line = <STDIN>)) {
print $handle $line;
}
}
Функция kill в родительском блоке if посылает
сигнал нашему дочернему процессу (в данный момент выполняющемуся в блоке
else) как только удаленный сервер закроет соединение со своей
стороны.
Если удаленный сервер посылает данные побайтно, а вам данные нужны сразу же,
без ожидания символа новой строки (который может никогда не прийти), вам
следует заменить цикл while родительского процесса на следующий
код:
my $byte;
while (sysread($handle, $byte, 1) == 1) {
print STDOUT $byte;
}
Вызывать системную функцию для каждого прочитанного байта не очень эффективно (и немилосердно), но это простейший способ объяснения и работает довольно неплохо.
Как всегда, создание сервера несколько сложнее, чем создание клиента. Суть
в том, что сервер создает сокет специального вида, который ничего не делает,
кроме как слушает определенный порт на предмет обнаружения входящих соединений.
Для этого сервер вызывает метод IO::Socket::INET->new() с
несколько другими аргументами, чем у клиента.
Какой используется протокол. Как и у нашего клиента, мы здесь указываем
"tcp".
Мы указываем локальный порт в аргументе LocalPort, этот
аргумент мы не использовали в клиенте. Это название службы или номер порта
на котором мы хотим видеть сервер. (В Unix порты с номерами меньше 1024
доступны только для суперпользователя.) В нашем примере мы будем использовать
порт 9000, но вы можете использовать любой порт, который еще не используется
в вашей системе. Если вы попытаетесь использовать порт, который уже
используется, вы получите соответствующее сообщение "Address already in use".
В Unix команда netstat -a показывает, серверы каких служб
сейчас запущены.
Параметр Listen указывает максимальное число ожидающих
соединений, которые мы можем принять, не отклоняя входящие запросы.
Это можно рассматривать как очередь входящих звонков на вашем телефоне.
В низкоуровневом модуле Socket имеется специальный символ для обозначения
максимального системного значения этого параметра - SOMAXCONN.
Параметр Reuse необходим, когда нам необходимо перезапустить
наш сервер вручную и мы не хотим ждать несколько минут, чтобы позволить
системе очистить буферы.
Как только основной сокет сервера будет создат с параметрами, указанными
выше, сервер будет ждать подключения новых клиентов. Сервер блокируется
на методе accept, который, наконец, устанавливает двустороннее
соединение от удаленного клиента. (Не забудьте установить autoflush для
полученного дескриптора, чтобы обойти буферизацию.)
Чтобы наш сервер был более дружественным к пользователю (user-friendliness),
он будет подсказывать команды. Большинство серверов этого не делают. Так как
подсказка будет без символа новой строки в конце, вам нужно будет использовать
вариант интерактивного клиента с функцией sysread, который был
описан выше.
Этот сервер распознает пять различных команд и отсылает ответ назад клиенту. В отличие от большинства сетевых серверов, наш может одновременно обслуживать только одно клиентское подключение. Многопоточные серверы рассмотрены в главе 6 Camel (верблюда?).
Вот весь код:
#!/usr/bin/perl -w
use IO::Socket;
use Net::hostent; # для OO версии gethostbyaddr
$PORT = 9000; # выберите какой-нибудь неиспользуемый
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "невозможно запустить сервер" unless $server;
print "[Сервер $0 готов к приему клиентов]\n";
while ($client = $server->accept()) {
$client->autoflush(1);
print $client "Добро пожаловать на $0; наберите help для вывода списка команд.\n";
$hostinfo = gethostbyaddr($client->peeraddr);
printf "[Соединение с %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
print $client "Команда? ";
while ( <$client>) {
next unless /\S/; # пустая строка
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 "Команды: quit date who cookie motd\n";
}
} continue {
print $client "Команда? ";
}
close $client;
}
К другому виду клиентов и серверов относятся те, которые используют не соединения, а сообщения. Взаимодействие по UDP требует гораздо меньших затрат, но оно также менее надежно, т.к. нет никаких сведений о том, достигли ли сообщения адресата, пришли ли в том же порядке, не были ли повреждены. Однако, у UDP имеются некоторые преимущества перед TCP, например, сообщения могут быть одновременно направлены целой группе хостов (обычно в пределах локальной сети). Если вы сильно озабочены надежностью и начинаете встраивать проверки в вашу систему сообщений, вам следует начинать с использования протокола TCP.
Запомните, что дейтаграммы UDP - это не потоки байт, и они должны обрабатываться соотвествующим образом. Поэтому использование механизмов ввода/вывода с внутренними буферами, таких как stdio (т.е. print() и прочие) особенно затруднительно. Используйте syswrite() или лучше send(), как в следующем примере.
Вот пример UDP программы, схожий с Интернет TCP клиентом, приведенным выше. Но, вместо проверки хостов поочередно, UDP версия проверяет несколько хостов асинхронно, симулируя многоадресную рассылку (multicast), а затем использует select() для ожидания ввода/вывода. Чтобы проделать что-то подобное с TCP, вам придется использовать различные дескрипторы сокетов для каждого хоста.
#!/usr/bin/perl -w
use strict;
use Socket;
use Sys::Hostname;
my ( $count, $hisiaddr, $hispaddr, $histime,
$host, $iaddr, $paddr, $port, $proto,
$rin, $rout, $rtime, $SECS_of_70_YEARS);
$SECS_of_70_YEARS = 2208988800;
$iaddr = gethostbyname(hostname());
$proto = getprotobyname('udp');
$port = getservbyname('time', 'udp');
$paddr = sockaddr_in(0, $iaddr); # если 0, то выбирает ядро
socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
bind(SOCKET, $paddr) || die "bind: $!";
$| = 1;
printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
$count = 0;
for $host (@ARGV) {
$count++;
$hisiaddr = inet_aton($host) || die "неизвестный хост";
$hispaddr = sockaddr_in($port, $hisiaddr);
defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
}
$rin = '';
vec($rin, fileno(SOCKET), 1) = 1;
# таймаут 10.0 секунд
while ($count && select($rout = $rin, undef, undef, 10.0)) {
$rtime = '';
($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
($port, $hisiaddr) = sockaddr_in($hispaddr);
$host = gethostbyaddr($hisiaddr, AF_INET);
$histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
printf "%-12s ", $host;
printf "%8d %s\n", $histime - time, scalar localtime($histime);
$count--;
}
Этот пример не предпринимает попыток повторной передачи и поэтому может не связаться с доступным хостом. Самой очевидной причиной такого поведения является перегрузка очередей на передающем хосте, если список опрашиваемых хостов достаточно большой.
Хотя System V IPC используется не так широко, как сокеты, он имеет своих сторонников. Однако, хотя вы можете эффективно использовать SysV IPC или Berkeley mmap() чтобы получить разделяемую память, разделять переменную между несколькими процессами не получится. Это происходит оттого, что Perl может переместить вашу строку в памяти в тот момент, когда вы этого не хотите.
Вот простой пример, демонстрирующий использование разделяемой памяти.
use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
$size = 2000;
$id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
print "shm ключ $id\n";
$message = "Сообщение #1";
shmwrite($id, $message, 0, 60) || die "$!";
print "записано: '$message'\n";
shmread($id, $buff, 0, 60) || die "$!";
print "прочитано: '$buff'\n";
# буфер shmread заполняется нулевыми символами.
substr($buff, index($buff, "\0")) = '';
print "не " unless $buff eq $message;
print "заполняется\n";
print "удаляем shm $id\n";
shmctl($id, IPC_RMID, 0) || die "$!";
Вот пример семафора:
use IPC::SysV qw(IPC_CREAT);
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
print "shm ключ $id\n";
Поместите этот код в отдельный файл, будем запускать несколько процессов. Назовите файл take:
# создаем семафор
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 0 , 0 );
die if !defined($id);
$semnum = 0;
$semflag = 0;
# 'забираем' ('take') семафор
# ждем, когда семафор станет равным нулю
$semop = 0;
$opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
# Увеличиваем счетчик семафора
$semop = 1;
$opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
$opstring = $opstring1 . $opstring2;
semop($id,$opstring) || die "$!";
Поместите этот код в отдельный файл, будем запускать несколько процессов. Назовите файл give:
# 'отдаем' ('give') семафор
# запустите это в основном процессе и вы увидите
# что второй процесс продолжает выполнение
$IPC_KEY = 1234;
$id = semget($IPC_KEY, 0, 0);
die if !defined($id);
$semnum = 0;
$semflag = 0;
# Уменьшаем счетчик семафора
$semop = -1;
$opstring = pack("s!s!s!", $semnum, $semop, $semflag);
semop($id,$opstring) || die "$!";
Приведенный код SysV IPC написан давно и выглядит весьма неуклюже. Более современный вид вы найдете в модуле IPC::SysV, который включен в Perl, начиная с версии 5.005.
Небольшой пример, демонстрирующий очереди сообщений SysV
use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
my $sent = "сообщение";
my $type_sent = 1234;
my $rcvd;
my $type_rcvd;
if (defined $id) {
if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
if (msgrcv($id, $rcvd, 60, 0, 0)) {
($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
if ($rcvd eq $sent) {
print "все в порядке\n";
} else {
print "все не в порядке\n";
}
} else {
die "# ошибка msgrcv\n";
}
} else {
die "# ошибка msgsnd\n";
}
msgctl($id, IPC_RMID, 0) || die "# ошибка msgctl: $!\n";
} else {
die "# ошибка msgget\n";
}
Большинство этих функций молча и вежливо возвращают undef
в случае ошибки, вместо того, чтобы вызвать завершение вашей программы из-за
неперехваченного исключения. (На самом деле, некоторые новые функции
преобразования в Socket вызывают croak() при ошибке в аргументах.)
Поэтому необходимо проверять возвращаемое значение этих функций. Всегда
начинайте программу, работающую с сокетами с этих строк, и не забывайте
флаг -T в первой строке для серверов:
#!/usr/bin/perl -Tw
use strict;
use sigtrap;
use Socket;
Все эти функции приводят к зависящим от системы проблемам переносимости. Perl зависит от ваших C библиотек и во многом от их поведения в системе. Пожалуй, наиболее безопасным будет забыть про семантику сигналов SysV и придерживаться только простых операций с сокетами TCP и UDP; к примеру, не пытайтесь передать открытые файловые дескрипторы через локальный дейтаграммный сокет UDP, если хотите, чтобы ваш код имел шанс на переносимость.
Том Кристиансен (Tom Christiansen), некоторые отрывки из оригинальной
версии Ларри Уолла (Larry Wall), учтены замечания от Perl Porters
(привратников Perl?)
Перевод Дениса Нелюбина (Denis Nelubin).
Существует гораздо больше трудов, посвященный сетевому взаимодействию, но с этого следует начать.
Для отважных программистов необходимой книгой будет Сетевое программирование Unix, 2-е издание, Том 1 Ричарда Стивенса (Unix Network Programming, 2nd Edition, Volume 1 by W. Richard Stevens) (изданное в Prentice-Hall). Большинство книг о сетях подают предмет с точки зрения C программиста; перевод на Perl остается упражнением для читателя.
Страница руководства IO::Socket(3) описывает объектно-ориентированную библиотеку, а страница руководства Socket(3) - низкоуровневый интерфейс сокетов. Кроме обычного описания функций в perlfunc, просмотрите также файл modules на ближайшем сайте CPAN. (Смотрите perlmodlib или лучше Perl FAQ, чтобы найти описание CPAN и где его найти.)
Раздел 5 файла modules посвящен "Сетям, Управлению устройствами (модемы) и Межпроцессному взаимодействию" ("Networking, Device Control (modems), and Interprocess Communication") и содержит множество модулей для сетевого взаимодействия, операции Chat и Expect, CGI программирование, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet, Threads и ToolTalk - вот только несколько названий.