(* Программа 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;


function fatal(s:pchar):integer;
begin
  perror (s);
  halt (1);
end;


(* Родительский процесс ожидает сигнала в трех каналах *)
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);
  halt (0);
end;


var
  pip:tp3;
  i:integer;
begin
  (* Создать три канала связи, и породить три процесса. *)
  for i:=0 to 2 do
  begin
    if not assignpipe (pip[i][0],pip[i][1]) then
      fatal ('Ошибка вызова pipe');
    case fork of
      -1:		(* ошибка *)
        fatal ('Ошибка вызова fork');
      0:		(* дочерний процесс *)
        child (pip[i]);
    end;
  end;
  parent (pip);
  halt (0);
end.
