Приглашаем посетить
16.15. Установка обработчика сигнала
Проблема
Вы хотите управлять реакцией программы на сигналы. Это может понадобиться для перехвата Ctrl+C, избежания накопления завершившихся подпроцессов или предотвращения гибели вашего процесса при попытке передать данные исчезнувшему потомку.
Решение
Воспользуйтесь хэшем %SIG для установки обработчика по имени или ссылке на код:
$SIG{QUIT} = \&got_sig_quit; # Вызвать
&got_sig_quit # для каждого
SIGQUIT $S1G{PIPE} = 'got_sig_pipe'; # Вызвать
main::got_sig_pipe
# для каждого
SIGPIPE $SIG{INT} = sub { $ouch++ }; # Увеличить $ouch для каждого SIGINT
Хэш %SIG также позволяет игнорировать сигнал:
$SIG{INT} = 'IGNORE';
# Игнорировать сигнал INT Также есть возможность восстановить стандартный обработчик сигнала:
$SIG{STOP} = 'DEFAULT'; # Восстановить стандартный обработчик
# сигнала STOP
Комментарий
Хэш %SIG используется в Perl для управления тем, что происходит при получении сигналов. Каждый ключ %SIG соответствует определенному сигналу, а значение - действию, которое должно предприниматься при его получении. В Perl предусмотрены два особых ассоциированных значения: "IGNORE" означает, что при получении сигнала не следует выполнять никаких действий, a "DEFAULT" выполняет стандартные действия UNIX для данного сигнала.
Хотя программисты на С привыкли к термину SIGINT, в Perl используется только INT. Предполагается, что имена сигналов используются только в функциях, связанных с обработкой сигналов, поэтому префикс SIG оказывается лишним. Следовательно, чтобы изменить действия вашего процесса при получении сигнала SIGCHLD, следует присвоить значение $SIG{CHLD}.
Чтобы ваш код выполнялся при получении конкретного сигнала, в хэш заносится либо ссылка на код, либо имя функции (следовательно, при сохранении строки вам не удастся использовать обработчик с именем IGNORE или DEFAULT впрочем, для обработчика сигнала эти имена выглядят довольно странно). Если имя функции не содержит информации о пакете, Perl считает, что функция принадлежит пакету main: :, а не тому пакету, в котором обработчик был установлен. Ссылка на код относится к конкретному пакету, и этот вариант считается предпочтительным.
Perl передает коду обработчика один аргумент: имя сигнала, по которому он вызывается (например, "INT" или "USR1"). При выходе из обработчика продолжается выполнение действий, выполнявшихся в момент поступления сигнала.
Perl определяет два специальных сигнала, __DIE__ и __WARN__. Обработчики этих сигналов вызываются каждый раз, когда программа на Perl выводит предупреждение (warn) или умирает (die). Это позволяет нам перехватывать предупреждения и по своему усмотрению обрабатывать их или передавать дальше. На время своего выполнения обработчики die и warn отключаются, поэтому вы можете спокойно вызвать die в обработчике __DIE__ или warn в обработчике __WARN__, не опасаясь рекурсии.
> Смотри также --------------------------------
Раздел "Signals" perlipc(1); страницы руководства sigaction(1), signal(3) и kill(2) вашей системы (если есть).
Проблема
Вы хотите установить обработчик сигнала, действующий только на время выполнения конкретной подпрограммы. Например, ваша подпрограмма перехватывает сигнал SIGINT, но за ее пределами SIGINT должен обрабатываться обычными средствами.
Решение
Используйте local для временного переопределения обработчика:
# Обработчик сигнала
sub ding {
$SIG{INT} = \&ding;
warn "\aEnter your name!\n";
}
# Запросить имя с переопределением SIGINT
sub get_name {
local $SIG{INT} = \&ding;
my $name;
print "Kindly Stranger, please enter your name:
chomp( $name = <> );
return $name;
}
Комментарий
Для временного сохранения одного элемента %SIG необходимо использовать local, а не ту. Изменения продолжают действовать во время выполнения блока, включая все, что может быть вызвано из него. В приведенном примере это подпрограмма get_name. Если сигнал будет доставлен во время работы другой функции, вызванной вашей функцией, сработает ваш обработчик сигнала - если только вызванная подпрограмма не установила собственный обработчик. Предыдущее значение элемента хэша автоматически восстанавливается при выходе из блока. Это один из немногочисленных случаев, когда динамическая область действия оказывается скорее удобной, нежели запутанной.
Смотри также: Рецепты 10.13; 16.15; 16.18.
Проблема
Требуется написать подпрограмму, которая будет вызываться программой при каждом получении сигнала.
Решение
Обработчик сигнала представляет собой обычную подпрограмму. С некоторой степенью риска в обработчике можно делать все, что допустимо в любой другой подпрограмме Perl, но чем больше вы делаете, тем больше рискуете.
В некоторых системах обработчик должен переустанавливаться после каждого сигнала:
$SIG{INT} = \&got_int;
sub got_int {
$SIG{INT} = \&got_int: # Но не для sigchld!
# ...
}
Некоторые системы перезапускают блокирующие операции (например, чтение данных). В таких случаях необходимо вызвать в обработчике die и перехватить вызов eval:
my $interrupted = 0;
# или 'IGNORE'
sub got_int {
$interrupted = 1;
$SIG{INT} = -default' die;
}
eval {
$SIG{INT} = \&got_int;
# ... Длинный код, который нежелательно перезапускать
}
If ($interrupted) {
# Разобраться с сигналом
}
Комментарий
Установка собственного обработчика сигнала напоминает игру с огнем: это очень интересно, но без исключительной осторожности вы рано или поздно обожжетесь. Создание кода Perl, предназначенного для обработки сигналов, чревато двумя опасностями. Во-первых, многие библиотечные функции нереентерабельны. Если сигнал прерывает выполнение какой-то 4)ункции (например, malloc(3) или printf(3)). а ваш обработчик сигнала снова вызовет ее, результат окажется непредсказуемым - обычно работа программы прерывается с выводом в файл содержимого памяти (core dump). Во-вторых, на нижних уровнях переентерабелен сам Perl (версия 5.005 будет поддерживать облегченные процессы, называемые нитями (threads), но на момент издания этой книги она еще не вышла). Если сигнал прерывает Perl в момент изменения его собственных внутренних структур данных, результат тоже непредсказуем - как правило, выдаются случайные дампы.
Перед вами открываются два пути: параноидальный и практический. Параноик постарается ничего не делать внутри обработчика сигнала; примером служит код с eval и die в решении - мы присваиваем значение переменной и тут же выходим из обработчика. Но даже это покажется слишком рискованным настоящему параноику, который избегает die в обработчиках - вдруг система на что-нибудь обидится? Практический подход - вы говорите: "Кто не рискует, тот не выигрывает", - и делаете в обработчике все, что заблагорассудится.
Сигналы были реализованы во многих операционных системах, причем не всегда одинаково. Отличия в реализации сигналов чаще всего проявляются в двух ситуациях: когда сигнал происходит во время активности обработчика (надежность) и когда сигнал прерывает блокирующий вызов системной функции типа read или accept (перезапуск).
Первоначальная реализация сигналов была ненадежной. Это означало, что во время работы обработчика при других поступлениях сигнала происходило некоторое стандартное действие (обычно аварийное завершение программы). Новые системы решают эту проблему (конечно, каждая - в своем, слегка особом стиле), позволяя подавлять другие экземпляры сигналов с данным номером до завершения обработчика. Если Perl обнаружит, что ваша система может использовать надежные сигналы, он генерирует соответствующие вызовы системных функций, чтобы программы вели себя более логично и безопасно. Система сигналов POSIX позволяет запретить доставку сигналов и в другие моменты времени (см. рецепт 16.20).
Чтобы получить по-настоящему переносимый код, программист-параноик заранее предполагает самое худшее (ненадежные сигналы) и вручную переустанавливает обработчик сигналов, обычно в самом начале функции:
$SIG{INT} = \&catcher;
sub catcher {
# ...
$SIG{INT} = \&catcher;
}
Особый случай перехвата SIGCHLD описан в рецепте 16.19. System V ведет себя очень странно и может сбить с толку,
Чтобы узнать, располагаете ли вы надежными сигналами, воспользуйтесь модулем Config:
use Config;
print "Htirrah!\n"
if $Config{d_sigaction};
Наличие надежных сигналов еще не означает, что вы автоматически получаете надежную программу. Впрочем, без них программа заведомо окажется ненадежной.
Первые реализации сигналов прерывали медленные вызовы системных функций, которые требовали взаимодействия со стороны других процессов или драйверов устройств. Если сигнал поступает во время выполнения этих функций, они (и их аналоги в Perl) возвращают признак ошибки и присваивают коду ошибки EINTR, "Interrupted system call". Проверка этого условия настолько усложняет программу, что во многих случаях это вообще не делается, поэтому при прерывании сигналом медленных системных функций программа начинает вести себя неверно или аварийно завершается. Большинство современных версий UNIX позволяет изменить ход событий. Perl всегда делает системные функции перезапускаемыми, если эта возможность поддерживается системой. В системах POSIX можно управлять перезапуском с помощью модуля POSIX (см. рецепт 16.20).
Чтобы узнать, будет ли прерванная системная функция автоматически перезапущена, загляните в заголовочный файл signal.h нашей системы:
% egrep oS[AV:L(RESTART| INTERRUPT) o /usr/include/./bnal. h
16.18. Перехват Ctrl+С 593
Два сигнала не перехватываются и не игнорируются: SIGKILL и SIGSTOP. Полная информация о сигналах вашей системы и об их значении приведена в странице руководства signal(3).
> Смотри также -------------------------------
Раздел "Signals" perlipc(1); страницы руководства sigaction(2), signal(1) и kill(2) вашей системы (если есть).
Проблема
Требуется перехватить нажатие Ctrl+C, приводящее к остановке работы программы. Вы хотите либо игнорировать его, либо выполнить свою собственную функцию при получении сигнала.
Решение
Установите обработчик для SIGINT. Присвойте ему "IGNORE", чтобы нажатие Ctrl+C игнорировалось:
$SIG{INT} = -ignore';
Или установите собственную подпрограмму, которая должна реагировать на Ctrl+C:
$SIG{INT} = \&tsktsk;
sub tsktsk {
$SIG{INT} = \&tsktsk; # См. "Написание обработчика сигнала"
warn "\aThe long habit of living indisposeth us for dying.\n";
}
Комментарий
Ctrl+C не влияет на вашу программу напрямую. Драйвер терминала, обрабатывающий нажатия клавиш, опознает комбинацию Ctrl+C (или другую комбинацию, заданную вами в качестве символа прерывания при настройке параметров терминала) и посылает SIGINT каждому процессу активной группы (активного задания) данного терминала. Активное задание обычно состоит из всех программ, запущенных отдельной строкой в командном интерпретаторе, а также всех программ, запущенных этими программами. За подробностями обращайтесь к разделу введения "Сигналы".
Символ прерывания - не единственный служебный символ, интерпретируемый драйвером терминала. Текущие параметры терминала можно узнать с помощью команды stty -a:
% stty -а speed 9600 baud; 38 rows; 80 columns;
Iflags: icanon isig iexten echo echoe -echok echoke -echoni echocti
-echoprt -altwerase -noflsh -tostop -flusho pendin -nokerninfo
-extproc iflags: -istrip icrni -inlcr -igncr ixon -ixoff ixany imaxbel -ignbrk
brkint -inpck -ignpar -parmrk oflags: opost onlcr oxtabs cflags: cread cs8 -parenb
-parodd hupcl -clocal -cstopb -crtscts -dsrflow
-dtrflow -mdmbuf cchars: discard = ~0; dsusp = ~y; eof = ~d; eol =
eol2 =
stop = "s; susp = "z; time = 0; werase = ~w;
В последней секции, cchars:, перечисляются служебные символы. В рецепте 15.8 показано, как изменить в сценарии без вызова программы stty.
> Смотри также -------------------------------
Страница руководства stty( 1) вашей системы (если есть); рецепты 15.8; 16.17.
Проблема
Программа создает порожденные процессы с помощью fork. Зомби накапливаются, забивают таблицу процессов и раздражают системного администратора.
Решение
Если вам не нужно регистрировать завершившихся потомков, используйте:
$SIG{CHLD} = 'ignore';
Чтобы следить за умирающими потомками, установите обработчик SIGCHLD с вызовом waitpid:
use POSIX ":sys_wait_h";
$SIG{CHLD} = \&reaper:
sub REAPER {
my $stiff;
while ($stiff = waitpid(-1, &wnohang) > 0) {
# Обработать $stiff, если нужно
}
$SIG{CHLD} = \&reaper: # Установить *после* вызова waitpid
}
Комментарий
Когда процесс завершается, система оставляет его в таблице процессов, чтобы родитель мог проверить его статус, то есть узнать, как завершился потомок, нормально или аварийно. Определение статуса потомка (после которого он получает возможность навсегда покинуть систему) называется "чисткой" (reaping). В этом рецепте приведены различные рекомендации по чистке зомби. В процессе чистки используется вызов wait или waitpid. Некоторые функции Perl (конвейерные вызовы open, system и '...') автоматически вычищают созданных ими потомков, но при запуске другого процесса с помощью fork вам придется дожидаться его завершения.
Чтобы избежать накопления зомби, достаточно сообщить системе, что они вас не интересуют. Для этого $SIG{.CHLD} присваивается значение "IGNORE". Если вы хотите узнать, когда скончался тот или иней потомок, необходимо использовать waitpid.
Функция waitpid вычищает один процесс. Ее первый аргумент определяет идентификатор процесса (-1 означает любой процесс), а второй - набор флагов. Флаг WNOHANG заставляет waitpid немедленно вернуть 0, если нет ни одного мертвого потомка. Флаг 0 поддерживается всеми системами и означает блокирующий вызов. Вызов waitpid в обработчике SIGCHLD (см. решение) вычищает потомков сразу после их смерти.
Функция wait тоже вычищает потомков, но она вызывается только в блокирующем режиме. Если случайно вызвать ее при наличии работающих потомков, ни один из которых не умер, программа приостанавливается до появления зомби.
Поскольку ядро следит за недоставленными сигналами посредством битового вектора (по одному биту на сигнал), если до перехода вашего процесса в активное состояние умрут два потомка, процесс все равно получит один сигнал SIGCHLD. Чистка в обработчике SIGCHLD всегда выполняется в цикле, поэтому wait использовать нельзя.
И wait и waitpid возвращают идентификатор только что вычищенного процесса и Присваивают $? его статус ожидания. Код статуса в действительности состоит из двух 8-разрядных значений, объединенных в одном 16-разрядном числе. Старший байт определяет код возврата процесса. Младшие 7 бит определяют номер сигнала, убившего процесс, а 8-й бит показывает, произошла ли критическая ошибка. Составляющие можно выделить следующим образом:
$exit_value = $? " 8;
$signal_num \= $? & 127;
$dumped_core = $? & 128;
Стандартный модуль POSIX содержит специальные макросы для выделения составляющих статуса: WIFEXITED, WEXITSTATUS, WIFSIGNALLED и WTERMSIG. Как ни странно, POSIX не содержит макроса для определения того, произошла ли критическая ошибка.
При использовании SIGCHLD необходимо помнить о двух обстоятельствах. Во-первых, сигнал SIGCHLD посылается системой не только при завершении потомка; сигнал также посылается при остановке. Процесс может остановиться по многим причинам - он может ожидать перехода в активное состояние для выполнения терминального ввода/вывода, получить сигнал SIGSTOP (после чего будет ожидать SIGCONT для продолжения работы) или быть приостановленным с терминала. Проверьте статус функцией WIFEXITED* модуля POSIX, чтобы убедиться, что процесс действительно умер, а не был остановлен:
use POSIX qw(:signal_h :errno_h);
$SIG{CHLD} = \&reaper;
sub REAPER { my $pid;
$pid = waitpid(-1, &wnohang);
if ($pid == -1) {
# Ожидающих потомков нет. Игнорировать.
} elsif (WIFEXITED($?)) {
print "Process $pid exited.\n";
} else {
print "False alarm on $pid.\n";
} $SIG{CHLD} = \&reaper; # На случай ненадежных сигналов
}
Вторая ловушка, связанная с SIGCHLD, относится к Perl, а не к операционной системе. Поскольку system, open и '. . . ' запускают подпроцессы через fork, а операционная система отправляет процессу SIGCHLD при выходе из любого подпро-цесса, вызов обработчика может быть и непредвиденным. Встроенные операции сами ожидают завершения потомков, поэтому иногда SIGCHLD прибывает до того, как вызов close для манипулятора заблокирует его для чистки. Если первым до него доберется обработчик сигнала, то к моменту нормального закрытия зомби уже не будет. В результате close вернет false и присвоит $! значение "No child processes". Если вызов close первым доберется до умершего потомка, waitpid возвращает 0.
В большинстве систем поддерживается неблокирующий режим waitpid. Об этом можно узнать из стандартного модуля Perl Config.pm:
use Config;
$has_nonblocking = $config{d_waitpid} eq "define" || $config{d_wait4} eq "define";
System V определяет сигнал SIGCLD, который имеет тот же номер, что и SIGCHLD, но слегка отличается по семантике. Чтобы избежать путаницы, используйте SIGCHLD.
> Смотри также -------------------------------
Раздел "Signals" perlipc(1) описание функций wait и waitpid в perlfunc(1); документация по стандартному модулю POSIX; страницы руководства sigaction(T), signal(3) и kill(2) вашей системы (если есть); рецепт 16.17.
Проблема
Требуется отложить прием сигнала - например, чтобы предотвратить непредсказуемые последствия от сигналов, которые могут прервать программу в любой момент.
Решение
Воспользуйтесь интерфейсом модуля POSIX к системной функции sigprocmask (только в POSIX-совместимых системах).
Блокировка сигнала на время выполнения операции выполняется так:
use POSIX qw(:signal_h);
$sigset = posix::sig8et->new(SIGINT): # Определить блокируемые сигналы
$old_sigset = posix::sigset->new; # Для хранения старой маски
unless (defined sigprocmask(SIG_BLOCK, $slgset, $old_sigset))
{ die "Could not block SIGINT\n";
}
Снятие блокировки выполняется так:
unless (defined sigprocmask(SIG_UNBLOCK, $old_sigset))
{ die "Could not unblock SIGINT\n":
}
Комментарий
В стандарт POSIX входят функции sigaction и sigprocmask, которые позволяют лучше управлять доставкой сигналов. Функция sigprocmask управляет отложенной доставкой сигналов, a sigaction устанавливает обработчики. При изменении %SIG Perl по возможности использует sigaction.
Чтобы использовать sigprocmask, сначала постройте набор сигналов методом POSIX: :SigSet->new. В качестве аргумента передается список номеров сигналов. Модуль POSIX экспортирует функции, возвращающие номера сигналов; имена функций совпадают с именами сигналов:
use POSIX qw(:signal_h);
$sigset = posix::sigset->new( SIGINT, SIGKILL );
Передайте объект POSIX::SigSet функции sigprocmask с нужным флагом. Флаг SIG_BLOCK откладывает доставку сигнала. Флаг SIG_UNBLOCK восстанавливает нормальную доставку сигналов, a SIG_GETMASK блокирует только сигналы, содержащиеся в POSIX::SigSet. Самые отчаянные перестраховщики блокируют сигналы при вызове fork, чтобы предотвратить вызов обработчика сигнала в порожденном процессе перед тем, как Perl обновит его переменную $$ (идентификатор процесса). Если обработчик сигнала вызывается немедленно и сообщает значение $$, то вместо своего собственного $$ он может использовать родительское значение. Такая проблема возникает очень редко.
> Смотри также -------------------------------
Страница руководства sigprocmask(2) вашей системы (если есть); документация по стандартному модулю POSIX.
Проблема
Вы хотите гарантировать, что продолжительность некоторой операции не превышает заданный промежуток времени. Допустим, вы проводите архивацию файловой системы и хотите прервать ее, если она затянется более чем на час. Или вы хотите, чтобы через час произошло некоторое событие.
Решение
Чтобы прервать затянувшуюся операцию, используйте обработчик SIGALRM и вызовите в нем die. Установите таймер функцией alarm и включите код в eval:
$SIG{ALRM} = sub { die "timeout" };
eval {
alarm(3600);
# Продолжительные операции alarm(O);
}
if ($@) {
if ($@ =~ /timeout/) {
# Тайм-аут; сделайте то, что считаете нужным
} else {
die; # Передать дальше неожиданное исключение
}
}
Комментарий
Функция alarm получает один аргумент: целое число секунд, после истечения которых ваш процесс получит SIGALRM. В сильно загруженных системах с разделением времени сигнал может быть доставлен позже указанного времени. По умолчанию SIGALRM завершает программу, поэтому вы должны установить собственный обработчик сигнала.
Функции alarm нельзя (с пользой) передать дробное число секунд; если вы попытаетесь это сделать, число секунд будет округлено до целого. Создание более точных таймеров рассматривается в рецепте 3.9.
Смотри также: Раздел "Signals" perlipc(1); описание функции alarm в perlfunc(1); рецепт 3.9.
Следующая программа выдает случайные подписи с применением именованных каналов. Предполагается, что файл подписей хранится в формате программы fortune - то есть каждый многострочный блок завершается последовательностью "%%\n". Приведем-пример:
Make is like Pascal: everybody likes it, so they go in and change it.
--Dennis Ritchie %%
I eschew embedded capital letters in names; to my prose-oriented eyes, they are too awkward to read comfortably. They jangle like bad typography.
--Rob Pike %% God made the integers; all else is the work of Man.
--Kronecker %%
I'd rather have :rofix than const. --Dennis Ritchie %%
If you want to program in C, program in C. It's a nice language. I use it occasionally... :-) --Larry Wall %% Twisted cleverness is my only skill as a programmer.
--Elizabeth Zwicky %%
Basically, avoid comments. If your code needs a comment to be understood, it would be better to rewrite it so it's easier to understand.
--Rob Pike %% Comments on data are usually much more helpful than on algorithms,
--Rob Pike %% Programs that write programs are the happiest programs in the wor1'!
--Andrew Hume
%%
Мы проверяем, не была ли программа запущена ранее - для этого используется файл с идентификатором процесса. Если посылка сигнала с номером 0 показывает, что идентификатор процесса все еще существует (или, что случается редко - что им воспользовался кто-то другой), программа просто завершается. Также мы проверяем текущую отправку Usenet и решаем, следует ли искать специализированные файлы подписей для конкретных конференций. В этом случае можно завести разные подписи для каждой конференции, в которую вы пишете. Для большего разнообразия глобальный файл подписей иногда применяется даже при наличии специализированного файла.
Программа sigrand может использоваться даже в системах без именованных каналов - достаточно удалить код создания именованного капала и увеличить паузу перед обновлениями файла. После этого .signature может быть обычным файлом. Другая проблема переносимости возникает при переходе программы в фоновый режим (при котором она почти становится демоном). Если функция fork недоступна, просто закомментируйте ее.
Полный текст программы приведен в примере 16.12.
Пример 16.12. sigrand
#!/usr/bin/perl -w
# sigrand - выдача случайных подписей для файла .signature
use strict;
# Конфигурационные переменные
use vars qw( $NG_IS_DIR $MKNOD $FULLNAME
$FIFO $ART $NEWS $SIGS $SEMA $GLOBRAND $NAME );
# Глобальные имена
use vars qw( $Home $Fortune_Path @Pwd );
##############
# Начало секции конфигурации
# В действительности следует читать из '/.sigrandrc
gethome();
# rес/humor/funny вместо rec.humor.funny $NG_IS_DIR = 1;
$MKNOD = "/bin/mknod";
$FULLNAME = "$home/.fullname";
$FIFO = "$home/.signature";
$ART = "$home/.article";
$NEWS = "$home/news";
$SIGS = "smews/signatures";
$SEMA = "$home/.sigrandpid";
$GLOBRAND = 1/4; # Вероятность использования глобальных
# подписей при наличии специализированного файла
# $NAME следует: (1) оставить неопределенным, чтобы программа
# попыталась угадать адрес подписи (возможно, заглянув
# в '/.fullname, (2) присвоить точный адрес, или (3) присвоить
# пустую строку, чтобы отказаться от использования имени.
$NAME = ''; # Означает, что имя не используется
# $NAME = "me\@home.org\n";
# Конец секции конфигурации -- HOME и FORTUNE # настраиваются автоматически
###################
setup(); # Выполнить инициализацию
justme(); # Убедиться, что программа еще не работает
fork && exit; # Перейти в фоновый режим
open (SEMA, "> $SEMA") or die "can't write $SEMA: $!";
print SEMA "$$\n";
close(SEMA) or die "can't close $SEMA: $!";
# В бесконечном цикле записывать подпись в FIFO.
# Если именованные каналы у вас не поддерживаются, измените
# паузу в конце цикла (например, 10, чтобы обновление
# происходило только каждые 10 секунд).
for (:;) {
open (FIFO, "> $FIFO") or die "can't write $FIFO: $!";
my $sig = pick_quote();
for ($sig) {
s/"(( :'?["\n].\n){4}). *$/$1/s; # Ограничиться 4 строками
s/"(.{1,80}).*? *$/$1/gm; # Обрезать длинные строки
}
# Вывести подпись с именем, если оно присутствует,
# и дополнить до 4 строк
if ($NAME) {
print FIFO $NAME, "\n" x (3 - ($sig =~ tr/\n//)), $sig;
} else {
print FIFO $sig;
} close FIFO: o
# Без небольшой паузы приемник не закончит чтение к моменту,
# когда передатчик снова попытается открыть FIFO;
# поскольку приемник существует, попытка окажется успешной.
# В итоге появятся сразу несколько подписей.
# Небольшая пауза между открытиями дает приемникам возможность и завершить чтение и закрыть канал.
select(undef, undef, undef, 0.2); # Выждать 1/5 секунды
} die "XXX: NOT REACHED"; # На эту строку вы никогда не попадете
#########################################
# Игнорировать SIGPIPE на случай, если кто-то открыл FIFO и
# снова закрыл, не читая данных; взять имя пользователя из файла
# .fullname. Попытаться определить полное имя хоста. Следить за
# амперсандами в паролях. Убедиться, что у нас есть подписи или
# цитаты. При необходимости построить FIFO.
sub setup {
$SIG{PIPE} = -ignore';
unless (defined $NAME) { # Если $NAME не определено
if (-e $FULLNAME) { # при конфигурации
$NAME = 'cat $fullname';
die "$FULLNAME should contain only 1 line, aborting" if $NAME =~ tr/\n// > 1;
} else { my($user, $host);
chop($host = 'hostname');
($host) = gethostbyname($host)
unless $host =~ /\./\ $user = $env{user} || $env{logname} || $pwd[0]
or die "intruder alert";
($NAME = $pwd[6]) =~ s/,.*//;
$NAME =~ s/&/\u\l$user/g; # До сих пор встречается
$NAME = "\t$name\t$user\@$host\n";
}
}
check_fortunes() if !-e $SIGN
unless (-p $FI,FO) { # -p проверяет, является ли операнд
# именованным каналом if (!-e _) {
system("$MKNOD $FIFO p") && die "can't mknod $FIFO";
warn "created $FIFO as a named pipe\n";
} else {
die "$0: won't overwrite file .signature\n";
} eise {
warn "$0: using existing named pipe $FIFO\n";
}
# Получить хорошее начальное значение для раскрутки генератора.
# Не нужно в версиях 5.004 и выше.
srand(time() " ($$ + ($$ " 15)));
}
# Выбрать случайную подпись
sub pick_quote {
my $sigfile = signame();
if (!-e $sigfile) { return fortune();
}
open (SIGS, "< $sigfile" ) or die "can't open $sigfile'
local $/ = "%%\n";
local $_;
my $quip;
rand($.) < 1 && ($quip = $_) while ;
close SIGS:
chomp $quip;
return $quip || "ENOSIG: This signature file is empty.\n";
}
# проверить, содержит ли "/.article строку Newsgroups. Если содержи],
# найти первую конференцию и узнать, существует ли для нее
# специализированный набор цитат; в противном случае вернуть глобальный
# набор. Кроме того, время от времени возвращать глобальный набор
# для внесения большего разнообразия в подписи.
sub signame {
(rand(-I.O) > ($GLOBRAND) && open ART) || return $SIGS;
local $/ = ' ';
local $_ = ;
my($ng) = /newsgroups:\s.([",\s]*)/;
$ng =~ s'\.!/'g if $ng_is_dir; # if rn -/, or savedir=%p/%c $ng =
"$NEWS/$ng/SIGNATURES":
return -f $ng ? $ng : $SIGS;
}
# вызывать программу fortune с параметром -s до тех пор,
# пока мы не получим достаточно короткую цитату или не Я превысим лимит попыток,
sub fortune {
local $_;
my $tries = 0;
do {
$_ = '$fortune_path -s';
} until tr/\n// < 5 || $tries++ > 20;
s/7 /mg:
$_ 11 " SIGRAND: deliver random signals to all processes.\n";
}
# Проверить наличие программы fortune. Определить полный путь
# и занести его в глобальную переменную. sub check_fortunes {
return if $Fortune_Path; # Уже найден
for my $dir (split(/:/, $ENV{PATH}), '/usr/games') { return if -x ($Fortune_Path =
"$dir/fortune"):
}
die "Need either $SIGS or a fortune program, bailing out":
}
# Определение каталога
sub gethome {
@Pwd = getpwuid($<);
$Home = $env{home} || $env{logdir} || $pwd[7]
or die "no home directory for user $<";
}
# "Останется только один" -- из фильма "Горец" sub justme {
if (open SEMA) { my $pid;
chop($pid = );
kill(0, $pid) and die "$0 already
running (pid $pid), bailing out' close SEMA;
}
}
