Межпроцессовые взаимодействия в UNIX

Давным-давно в одной далекой галактике жил-был DOS. И было у него всего-навсего 640 килов памяти, и мог выполнять он лишь только одну задачу. И появился грозный монстр Windows, который разделил процессорное время на части. Одну часть отвел он сонмищу процессов, а другую часть – сонмищу потоков. И перекликались они с помощью мьютексов и семафоров. А данные передавались где как. Была там и общая куча (heap), и пайпы кой где работали… В общем рассказывать дальше думаю не имеет смысла. Еще много чего можно написать - все это скучно и отвлекает от основных целей.

Так как все здесь описанное связанно с Perl, который проектировался с ориентировкой на UNIX-системы, все системные фишки, которые здесь будут рассмотрены, относятся именно к UNIX-системам. Конечно, реализация Perl для Windows скрывает кое-какие несоответствия, но далеко не все. Так что, сильно не огорчайтесь, если что-то не работает. Безвыходных ситуаций не бывает. Пишите в форум, а еще лучше побольше экспериментируйте – тогда все получится.

Итак, процесс – это программа, код которой выполняется независимо от других программ. Может быть это и не академическое определение, но ведь и наша задача не обозвать это правильно, а понять – как это работает и какая нам может быть от этого польза. Дабы не углубляться в системные тонкости, представим ситуацию на известных нам примерах.

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

Так вот, можно привести аналогию с многозадачной операционной системой: код вне процедур здесь будет представлять код ядра, который управляет всеми процессами- процедурами. Но здесь маленькое, но важное примечание. Когда в нашей аналогии ядро вызывает процедуру это запуск процесса, но не ее выполнение и ожидание ее завершения. Ядро где-то там у себя в хэше процессов создает новую пару имя- значение, имя которого есть имя процедуры, а значение – номер строки последовательности операторов процедуры, на которой остановилось выполнение (то есть после запуска это 0). После этого, ядро перебирает все ключи из хэша и смотрит на имя и номер строки. Переходит на эту строку в нужной процедуре и выполняет, к примеру, следующие пять строк. Дальше следующая процедура, так до конца, а потом опять в начало хэша.

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

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

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

fork;

На самом деле, оператор fork возвращает значение, которое используется для определения процесса. К примеру, выходит человек из-за угла, а ему кирпичом по голове. Очнулся, а в руке у него на бумажке написано – ты номер 1. Он встал и пошел дальше. Пойти то пошел, да на его месте опять же этот человек лежит. А у него в руке бумажка, на которой написано – ты номер 2. Этот человек поднялся, подумал, что сейчас вот зайду за другой угол, а там опять кирпичом по голове дадут, и пошел в другую сторону.

Так вот, вернемся к нашим баранам. Одному процессу достается значение, идентифицирующее порожденный процесс. То есть, дописываем в бумажку первого человека фразу типа "у второго номер 2". Это бывает необходимым, в случае если подразумевается взаимодействие с порожденным процессом. Порожденный процесс, получает от fork значение 0. Но возможны такие ошибочные ситуации, когда создать процесс не удалось. Возвращаясь к нашему примеру, человек заходит за угол и… Ничего не происходит. Человек думает, странно, здесь на меня должен упасть кирпич, видимо погода нелетная. Разворачивается и идет домой. Когда fork не возвращает значения (undef), значит породить процесс не удалось. Это, несомненно, ошибочная ситуация и ее необходимо обработать. В общем случае вызов fork должен выглядеть так

unless defined(fork) { print "обработайте ошибку, или вместо этого вызовите die" }

#!/usr/bin/perl –w
# fork.pl

die "Non-flying weather" unless defined(fork);
print "I'm number $$\n";

[root@avalon tests]# ./fork.pl
I'm number 6773
I'm number 6774

Да, важно завершать процесс оператором exit.

#!/usr/bin/perl –w
# nfilter.pl

filter();
for ($i = 0; $i < 20; $i ++)
{ print "Output line $i\n"; }

sub filter
{
    die "Cannot fork" unless defined($fpid = open(STDOUT,"|-"));
	return if ($fpid != 0);
	num = 0;
	while (<STDIN>) { print "$num:\t$_"; $num ++; }
	exit;
}

open(HANDLE, "| $cmd"); # направить информацию на вход программы

while (<STDIN>) { print "$num:\t$_"; $num ++; }

#!/usr/bin/perl –w
# nfilter.pl

filter();
for ($i = 0; $i < 20; $i ++)
{ print "Output line\n"; }
close(STDOUT);

sub filter
{
die "Cannot fork" unless defined($fpid = open(STDOUT,"|-"));
	return if ($fpid != 0);
	num = 0;
	while (<STDIN>) { print "$num:\t$_"; $num ++; }
	exit;
}

Для решения этой проблемы, нужно вспомнить о таких полезных в данном случае функциях как select pipe. Функция select подменяет STDOUT новым дескриптором, а возвращает дескриптор потока вывода, который был актуален на момент до выполнения select, иначе говоря текущий STDOUT. Функция pipe связывает два дескриптора в режиме чтения-записи, то есть создает односторонний канал обмена данными. Отсюда и название – pipe.

В UNIX - все потоки равны. Прям, коммунизм какой-то. А нам какая с этого польза? Например, мы легко можем подсунуть функции select один из дескрипторов, связанных функцией pipe. Естественно, что будем подсовывать тот, который предназначен для записи, иначе за поручиться трудновато. В общем получаем следующее

#!/usr/bin/perl –w
# errfilter.pl

my ($fpid,$oldout);

pipe(FOR_READ,FOR_WRITE);
select((select(FOR_READ),$| = 1)[0]);
select((select(FOR_WRITE),$| = 1)[0]);

start_filter();

for ($i = 0; $i < 20; $i ++)
{ print "Output line\n"; }

# Error("bug");

close(FOR_WRITE);
waitpid($fpid,0);

sub start_filter
{
	die "Cannot fork" unless defined($fpid = fork);
        unless ($fpid == 0)
        {
	        close(FOR_READ);
	        $oldout = select(FOR_WRITE);
        	return;
        }

	close(FOR_WRITE);
	my ($out,$num) = ("",0);
	while(<FOR_READ>) { $out .= "$num\t$_"; $num ++; }
        close(FOR_READ);
        print $out;
        exit;
}

sub Error
{
	my ($error_text) = @_;
        select($oldout);
        kill KILL => $fpid;
        close(FOR_WRITE);
        print "Error: $error_text\n";
        exit;
}

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

Вернемся к функции start_filter() в той его части, где выполняется непосредственно фильтрация. Первым делом неиспользуемый в дочернем процессе конец канала закрывается. Далее, процесс в цикле считывает данные из канала и аккумулирует их в переменной $out. Запустите программу, Работает? По крайней, мере должна.

Теперь уберите комментарии из строки, где вызывается функция Error("bug"). Запустите программу снова и посмотрите на результат. Этого мы добивались? (Правильный ответ да, если нет, то смотрите что вы там понаписали).

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

Смысл сервера с ветвлением в многопроцессовой обработке клиентов. Представьте себе, что несколько клиентских программ попытаются обратиться к обычному серверу, такому, как мы создали в предыдущей главе. Что произойдет? Тот клиент, который обратился первым и будет первым обработан. А что со вторым? Второй будет ждать своей очереди. Это не всегда приемлемо. Тем более, что мы работаем в полноценной многозадачной среде.

Механизм работы

Давайте попробуем спроектировать подобный сервер. Итак, наш сервер дождался входящего подключения. Вместо того, что бы сразу приступить к работе склиентом, мы будем ответвлять новый процесс. После ответвления родительский процесс будет снова переведен в состояние ожидания входящих подключений, а порожденный процесс будет работать с клиентом. Сразу хочу заметить, что такое решение не подойдет для сервера, который подразумевает совместное использование данных, поступающих от разных клиентов. То есть, например, для организации сервера обмена пользовательскими сообщениями (когда клиент отправляет данные, которые необходимо разделить между другими клиентами) более подходящим будет метод последовательной обработки клиентов в одном процессе. Но для нашего случая этого не требуется - каждый клиент работает только с сервером и никак не взаимодействует с другими клиентами.

Общая схема работы теперь выглядит так:

#!/usr/bin/perl -w
# sited.pl
use Socket;
my $host = "localhost";
my $port = 10000;
my $work = 1;

my $sock_name = GetSockName($host,$port)
	or die "Couldn't convert into an Internet address: $!\n";
socket(SERVER,PF_INET,SOCK_STREAM,getprotobyname('tcp'))
	or die "Couldn't create socket: $!\n";
setsockopt(SERVER,SOL_SOCKET,SO_REUSEADDR,1)
or die "setsockopt() failed: $!\n";
bind(SERVER,$sock_name)
or die "Couldn't bind to port $port: $!\n";
listen(SERVER,SOMAXCONN);

while($work){
	print "[$$] Awaiting incoming connections...\n";
	my $rem_addr = accept(CLIENT,SERVER);
	my ($ip,$pt) = GetSockAddr($rem_addr);
	print "[$$] Connection from $ip:$pt\n";
	Client();
}
close(SERVER);
print "[$$] Server shutdown\n";

Всю специфическую работу выполняет функция Client. Рассмотрим ее работу:

sub Client(){
	my $pid = fork;
	unless(defined($pid)){
		print "[$$] Fork failed\n";
		return;
	}
	if ($pid != 0){ # Parent process
		print "[$$] New client process PID=$pid\n";
		close(CLIENT);
		return;
	}
	print "[$$] Sleep...Z-z-z-zzzzz\n";
	sleep(15);
	print "[$$] Send to client ",scalar(localtime),"\n";
	print CLIENT scalar(localtime);
	close CLIENT;
	exit;
}

Как видно из кода функции, наш сервер отправляет клиенту строку с текущим временем. В родительском процессе нам не нужен клиентский дескриптор, по этому мы сразу его закрываем. Если мы этого не сделаем, то сокет останется открытым даже после того, как порожденный процесс завершит свою работу. Из этой ситуации есть еще один выход: использовать функцию shutdown, которая закрывает сокет в любом случае (независимо от количества дескрипторов). Но, мне кажется, это не совсем правильно - оставлять открытым дескриптор, когда этого совсем не требуется. По этому, не будем привыкать к дурному тону и закроем сокет сами.

В коде часто встречаются строки типа

print "[$$] ...";

Мы выводим идентификатор текущего процесса, что бы различать порожденные процессы между собой. Давайте протестируем наш сервер. Откройте несколько консолей, в одной из которых запустите сервер. На других запустите нескольких клиентов. Благодаря задержке мы имеем возможность наблюдать параллельную работу с несколькими клиентами.

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

Добавим обработчик для сигналов HUP,INT и TERM сразу после вызова listen:

listen(SERVER,SOMAXCONN);
$SIG{HUP} = $SIG{INT} = $SIG{TERM} = \&UsKill;

Будьте внимательны со скобками после ссылки, а то получите присвоение результата вызова функции вместо ссылки. В обработчике мы выполняем сброс флага $work. А если в момент прихода сигнала мы будем заблокированы вызовом функции accept? Флаг то мы сбросим, но так и будем сидеть до первого входящего соединения. Можно решить эту проблему созданием фиктивного подключения прямо из обработчика.

sub UsKill{
	print "[$$] Interrupted by signal: ",shift(),"\n";
	$work = undef;
	return unless socket(KILL,PF_INET,
                SOCK_STREAM,getprotobyname('tcp'));
	connect(KILL,$sock_name);
	close(KILL)
}

Таким образом мы решаем задачу непременного выхода из цикла. Первая задача решена - теперь сервер управляется с помощью сигналов. Проверим работоспособность сервера: запустите сервер и с другой консоли инициируйте подключение. Теперь, пока еще клиент не обработан полностью, в консоли с сервером нажмите Ctrl+C, таким обазом послав серверу сигнал INT. Все должно завершиться через 15 секунд (так как все клиентские подключения ожидают 15 секунд, в том числе и последнее фиктивное подключение). А теперь представьте, что время на обработку фиктивного соединения гораздо меньше, чем на обработку клиента. Ну и что - спросите вы. На реальном примере можно описать это следующим образом: вы заходите в магазин, подходите к продавцу, говорите "дайте мне булку хлеба", продавец берет с вас деньги и... исчезает в неопределенном направлении. Вам бы такое понравилось? Мы должны каким-то образом дождаться завершения работы всех клиентских процессов. Сделать это можно через функцию waitpid. Так как waitpid работает с идентификаторами процессов, то после ветвления нужно эти идентификаторы где-нибудь запоминать. Объявим хэш %pid где нибудь вначале программы (можно сразу после объявления переменной $work = 1). Почему хэш, а не массив? Потому, что из хэша легче удалять элементы. Далее, сразу после закрытия серверной стороны сокета (сразу после цикла while) добавим следующий код:

close(SERVER);
print "[$$] Server shutdown\n";
my @pids = keys(%pid);
foreach my $k (@pids){
	print "[$$] Waiting process $k...\n";
	waitpid($k,0);
}

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

Есть еще одна сложность. После того, как клиентский процесс завершит свою работу, он превращается в зомби. Никакой мистики, просто система оставляет информацию о завершившемся процессе в таблице процессов для того, что бы родительский процесс смог проанализировать результат его работы. Если ничего не сделать, то после того, как сервер проработает некоторое время, таблица процессов будет переполнена записями о процессах-зомби. Что бы в результате этого нам не пришлось не выслушивать администратора системы, для решения этой проблемы нужно указать системе что нас не интересуют потомки. Достигается это указанием необходимости игнорировать сигнал CHLD. Кроме этого, не забываем подчищать хэш %pid, в который добавляется идентификаторы всех порожденных процессов. Чистку хэша можно выполнять каждый раз после обработки нового входящего соединения. Давайте так и поступим.

Добавим в код сразу после переопределения обработчика сигналов HUP,INT и TERM следующий оператор:

$SIG{CHLD} = 'IGNORE';

А внутрь цикла while, после вызова функции Client следующие строки:

my @pids = keys(%pid);
foreach my $k (@pids){
	if (kill 0 => $k){
		print "[$$] $k is alive\n";
	}else{
		print "[$$] $k is deceased\n";
		delete($pid{$k});
	}
}

Мы перебираем идентификаторы всех порожденных процессов и удаляем те, которые выполнили свою работу. Функция kill посылает определенный сигнал процессу или группе процессов. Первым аргументом при вызове этой функции должен быть указан сигнал, а последующими - идентификаторы процессов. Если послать процессу сигнал 0, то функция kill вернет статус процесса: true, если процесс работает, или же false в случае, если процесс умер или сменил действующий идентификатор. Во втором случае уточнить статус процесса можно с помощью модуля POSIX, в котором описаны константы EPERM и ESRCH:

use POSIX qw/:errno_h/;
if (kill 0 => $pid){
	# Процесс жив
}elsif($! == EPERM){
	# Сменил идентификатор
}elsif($! == ESRCH){
	# Зомби
}

Для нашего случая этого делать не обязательно. В общем, вот таким образом мы контролируем своевременное удаление ненужных идентификаторов. Запустите и проверьте сервер - он должен дожидаться окончания выполнения каждого дочернего процесса, а так же своевременно вычищаеть хэш %pid.

Но есть и еще одно, более изящное решение этой проблемы. Мы можем переопределить обработчик сигнала CHLD. Сигнал CHLD приходит каждый раз, когда умирает дочерний процесс. Исправте код - вместо игнорирования сигнала CHLD определите ему новый обработчик - функцию ReapChld.

$SIG{CHLD} = \&ReapChld;

То, что мы добавили внутрь цикла while для своевременной очистки хэша %pid то же нужно удалить. Рассмотрим функцию ReapChld:

sub ReapChld{
	while(my $kid = waitpid(-1,WNOHANG)){
		last if $kid == -1;
		if (WIFEXITED($?)){
			print "[$$] Reap child process $kid\n";
			delete($pid{$kid});
		}
	}
	$SIG{CHLD} = \&ReapChld;
}

Итак, функция waitpid со значением -1 (указывает на любой процесс) в качестве первого аргументаи флагом WNOHANG в качестве второго возвращает 0, в случае если нет ни одного процесса-зомби. Эта функция вычищает один процесс и по этому мы запускаем обработку в цикле - так, на всякий случай. Цикл нужен для того, что бы быть уверенным в том что вычищены все потомки. Так, например, если несколько потомков умрут когда родительский процесс был неактивен, после перехода в активное состояние родитель получает всего один сигнал CHLD при нескольких мертвых потомках.

Если функция waitpid() возвращает -1, то это означает что нет ни одного зомби. Поэтому, значение -1 является сигналом к прерыванию цикла. После вызова waitpid встроенная переменная $? содержит статус ожидания - тот самый, из-за которого появляется зомби. Функция WIFEXITED модуля POSIX прверяет статус завершения потомка. Дело в том, что сигнал CHLD посылается не только в случае смерти потомка. Мы используем функцию WIFEXITED для определения - умер ли потомок, или же произошло другое событие.

Мне еще ни разу не встречалась ситуация, когда сбрасывался обработчик сигнала CHLD. Но в литературе допускается возможность сброса обработчика, поэтому, что бы не рисковать в ущерб стабильности мы восстанавливаем значение обработчика:

$SIG{CHLD} = \&ReapChld

Теперь добавте оператор подключения модуля POSIX (мы ведь используем его константы и функции). Можно сразу после подключения модуля Socket:

use POSIX qw/:signal_h :sys_wait_h :errno_h /;

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

[18539] Awaiting incoming connections...
[18539] Connection from 127.0.0.1:3347
[18542] Sleep...Z-z-z-zzzzz
[18542] Interrupted by signal: INT
[18542] Send to client Thu Aug 22 15:00:04 2002
[18539] Awaiting incoming connections...
[18539] Connection from 127.0.0.1:3347
[18539] New client process PID=18542
[18539] Awaiting incoming connections...
[18539] Connection from 127.0.0.1:3348
[18544] Sleep...Z-z-z-zzzzz
[18544] Interrupted by signal: INT
[18544] Send to client Thu Aug 22 15:00:04 2002
[18539] Awaiting incoming connections...
[18539] Connection from 127.0.0.1:3347
[18539] New client process PID=18542
[18539] Awaiting incoming connections...
[18539] Connection from 127.0.0.1:3348
[18539] New client process PID=18544
[18539] Awaiting incoming connections...
[18539] Reap child process 18542
[18539] Interrupted by signal: INT
[18539] Connection from 127.0.0.1:3349
[18547] Sleep...Z-z-z-zzzzz
[18547] Send to client Thu Aug 22 15:00:19 2002
[18539] Awaiting incoming connections...
[18539] Connection from 127.0.0.1:3347
[18539] New client process PID=18542
[18539] Awaiting incoming connections...
[18539] Connection from 127.0.0.1:3348
[18539] New client process PID=18544
[18539] Awaiting incoming connections...
[18539] Reap child process 18542
[18539] Interrupted by signal: INT
[18539] Connection from 127.0.0.1:3349
[18539] New client process PID=18547
[18539] Server shutdown
[18539] Waiting process 18547...
[18539] Reap child process 18544
[18539] Waiting process 18544...

Судя по идентификаторам процессов, сначала выполняется и завершается порожденный процесс и только после этого выводятся сообщения о порождении процесса. Как вы думаете, почему? Правильно, из-за буфферизации. Давайте отключим буфферизацию вывода. Для этого добавим сразу после подключения модулей Socket и POSIX:

$| = 1;

Запустите и проверьте. Ну, что опять не так? Подозрительные записи о тройной обработке сигнала INT при чем в различных процессах. О чем это говорит? Что сигнал INT получают и порожденные процессы. А так как мы переопределяем обработчик сигнала INT до разветвления, порожденный процесс наследует так же и обработчик. Для того, что бы потомок не реагировал на сигналы нужно просто отключить их обработку после того, как произойдет ветвление. Меняем функцию клиент:

sub Client{
	my $pid = fork;
	unless(defined($pid)){
		print "[$$] Fork failed\n";
		return;
	}
	if ($pid != 0){ # Parent process
		print "[$$] New client process PID=$pid\n";
		close(CLIENT);
		return;
	}
	$SIG{INT} = $SIG{HUP} = $SIG{TERM} = 'IGNORE';
	print "[$$] Sleep...Z-z-z-zzzzz\n";
	sleep(15) if defined($work);
	print "[$$] Send to client ",scalar(localtime),"\n";
	print CLIENT scalar(localtime);
	close CLIENT;
	exit;
}

Теперь должно быть все в порядке:

[18661] Awaiting incoming connections...
[18661] Connection from 127.0.0.1:3425
[18661] New client process PID=18663
[18661] Awaiting incoming connections...
[18663] Sleep...Z-z-z-zzzzz
[18661] Connection from 127.0.0.1:3426
[18661] New client process PID=18665
[18661] Awaiting incoming connections...
[18665] Sleep...Z-z-z-zzzzz
[18661] Interrupted by signal: INT
[18661] Connection from 127.0.0.1:3427
[18661] New client process PID=18666
[18661] Server shutdown
[18661] Waiting process 18663...
[18666] Sleep...Z-z-z-zzzzz
[18666] Send to client Thu Aug 22 15:26:49 2002
[18661] Reap child process 18666
[18663] Send to client Thu Aug 22 15:26:56 2002
[18661] Waiting process 18665...
[18665] Send to client Thu Aug 22 15:26:59 2002
[18661] Waiting process 18666...

package daemon;
use strict;
use POSIX qw/setsid/;
use IO::Handle;
our $VERSION='1.2';

sub Init{
    my ($this,$pidfile) = shift;
    return 0 unless $this->{"pidfile"} = $pidfile;
    return $this->OnInit( @_ );
}

sub Daemon{
    my ($this) = @_;
    my ($pid,$pidfile,$fh,$status);
    $this->mlog("daemon::Daemon") if $this->Debug();

    unless ($pidfile = $this->{"pidfile"}){
	$this->mlog("Pid file was not specified");
	return 1;
    }
    
    if ($this->IsRunning()){
	$this->mlog("Couldn't replace pid file while daemon is running");
	return 1;
    }
    
    unless (defined($pid = fork())){
	$this->mlog("Couldn't spawn child process: $!");
	return 1;
    }elsif ($pid != 0){
	# This is parent process
	return 0;
    }

    $this->{"im_daemon"} = 1;

    if ($pidfile){
	my $fh = IO::Handle->new;
	unless (open($fh,">",$pidfile)){
	    $this->mlog("Couldn't open pid file $pidfile: $!");
	    return 1;
	}else{
	    flock($fh,2);
	    print $fh $$;
	    flock($fh,8);
	    close($fh);
	    $this->mlog("Process ID saved: $pidfile") if $this->Debug();
	}
    }
    
    unless (setsid()){
	$this->mlog("Couldn't start daemon: $!");
	return 1;
    }
    
    $SIG{TERM} = \&daemon::_TERM;
    $SIG{HUP}  = \&daemon::_HUP;
    $SIG{USR1} = \&daemon::_USR1;
    $SIG{USR2} = \&daemon::_USR2;
        
    return 1 unless $this->OnDaemon();
    while (!$this->{"exit"} && $status = $this->Wait()){
	last unless $this->Work($status);
    }
    $status = $this->OnTerminate();
    unlink $pidfile if $pidfile && -e $pidfile;
    return $status ? 0 : 1;
}

# - sect
sub IsRunning{
    my $this = shift;
    my ($pidfile,$fh,$pid);
    unless ($pidfile = $this{"pidfile"}){
	$this->mlog("Pid file was not specified");
	return 0;
    }
    return 0 unless -e $pidfile;
    $fh = IO::Handle->new;
    unless (open($fh,$pidfile)){
	$this->mlog("Couldn't open pid file $pidfile: $!");
	return 0;
    }
    chomp($pid = <$fh>);
    close($fh);
    return $pid if kill(0,$pid);
    if (-e $pidfile){
	$this->mlog("Found pid of not existent process: $pidfile");
	unlink $pidfile;
    }
    return 0;
}

# - sect 3.1 - public commands
sub Terminate{
    my $this = shift;
    my $pid = $this->IsRunning();
    return 2 unless $pid;
    return kill(TERM => $pid) ? 0 : 1;
}

sub Reload{
    my $this = shift;
    my $pid = $this->IsRunning();
    return 2 unless $pid;
    return kill(HUP => $pid) ? 0 : 1;
}

sub User1{
    my $this = shift;
    my $pid = $this->IsRunning();
    return 2 unless $pid;
    return kill(USR1 => $pid) ? 0 : 1;
}

sub User2{
    my $this = shift;
    my $pid = $this->IsRunning();
    return 2 unless $pid;
    return kill(USR2 => $pid) ? 0 : 1;
}

# - sect 1.4 - virtual
sub OnInit{
    return 1;
}

sub OnDaemon{
    return 1;
}

sub Wait{
    return 1;
}

sub Work{
    return 0;
}

sub OnTerminate{
    return 1;
}

# - sect 1.2 - private



# - sect 0.1
sub Debug{
    my ($this,$flag) = @_;
    $this->{debug} = $flag if defined($flag);
    return $this->{debug};
}

sub new{
    my $class = shift;
    my $this = {};
    bless($this,$class);
    return $this;
}