Полищук, Семериков. Системное программирование в UNIX средствами Free Pascal / examples / 7 / server

(* рТПЗТБННБ 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.