(* Программа server - обслуживает три дочерних процесса *)
uses linux,stdio;
const
MSGSIZE=6;
msg1:array [0..MSGSIZE-1] of char = 'hello';
msg2:array [0..MSGSIZE-1] of char = 'bye!!';
type
tp1=array [0..1] of longint;
tp3=array [0..2] of tp1;
(* Родительский процесс ожидает сигнала в трех каналах *)
procedure parent(p:tp3); (* код родительского процесса *)
var
ch:char;
buf:array [0..MSGSIZE-1] of char;
_set, master:fdset;
i:integer;
begin
(* Закрыть все ненужные дескрипторы, открытые для записи *)
for i:=0 to 2 do
fdclose (p[i][1]);
(* Задать битовые маски для системного вызова select *)
FD_ZERO (master);
FD_SET (0, master);
for i:=0 to 2 do
FD_SET (p[i][0], master);
(* Лимит времени для вызова select не задан, поэтому он
* будет заблокирован, пока не произойдет событие *)
_set := master;
while select (p[2][0] + 1, @_set, nil, nil, nil) > 0 do
begin
(* Нельзя забывать и про стандартный ввод,
* т.е. дескриптор файла fd=0. *)
if FD_ISSET (0, _set) then
begin
write('Из стандартного ввода...');
fdread (0, ch, 1);
writeln(ch);
end;
for i:=0 to 2 do
begin
if FD_ISSET (p[i][0], _set) then
begin
if fdread (p[i][0], buf, MSGSIZE) > 0 then
begin
writeln('Сообщение от потомка', i);
writeln('MSG=', buf);
end;
end;
end;
(* Если все дочерние процессы прекратили работу,
* то сервер вернется в основную программу
*)
if waitpid (-1, nil, WNOHANG) = -1 then
exit;
_set := master;
end;
end;
function child (p:tp1):integer;
var
count:integer;
begin
fdclose (p[0]);
for count:=1 to 2 do
begin
fdwrite (p[1], msg1, MSGSIZE);
(* Пауза в течение случайно выбранного времени *)
sleep (getpid mod 4);
end;
(* Послать последнее сообщение *)
fdwrite (p[1], msg2, MSGSIZE);