(* Серверный процесс *)
uses sockets,stdio,linux;

const
  SIZE=sizeof(tinetsockaddr);
  server:tinetsockaddr = (family:AF_INET; port:7000; addr:INADDR_ANY);
  
var
  newsockfd:longint;

procedure catcher (sig:integer);cdecl;
begin
  fdclose (newsockfd);
  halt (0);
end;

var
  sockfd:longint;
  c:char;
  act:sigactionrec;
  mask:sigset_t;
  client:tinetsockaddr;
  clientaddrlen:longint;
begin
  act.handler.sh := @catcher;
  sigfillset (@mask);
  act.sa_mask:=mask.__val[0];
  sigaction (SIGPIPE, @act, nil);

  (* Установить абонентскую точку сокета *)
  sockfd := socket (AF_INET, SOCK_STREAM, 0);
  if sockfd = -1 then
  begin
    perror ('Ошибка вызова socket');
    halt (1);
  end;

  (* Связать адрес с абонентской точкой *)
  if not bind (sockfd, server, SIZE) then
  begin
    perror ('Ошибка вызова bind');
    halt (1);
  end;

  (* Включить прием соединений *)
  if not listen (sockfd, 5) then
  begin
    perror ('ошибка вызова listen');
    halt (1);
  end;

  while true do
  begin
    (* Прием запроса на соединение *)
    newsockfd := accept (sockfd, client, clientaddrlen);
    if newsockfd = -1 then
    begin
      perror ('Ошибка вызова accept');
      continue;
    end;

    (* Создать дочерний процесс для работы с соединением *)
    if fork = 0 then
    begin
      while recv (newsockfd, c, 1, 0) > 0 do
      begin
        c := upcase (c);
        send (newsockfd, c, 1, 0);
      end;

      (* После того, как клиент прекратит передачу данных,
       * сокет может быть закрыт и дочерний процесс
       * завершает работу *)
      fdclose (newsockfd);
      halt (0);
    end;

    (* В родительском процессе newsockfd не нужен *)
    fdclose (newsockfd);
  end;
end.
