(* Программа tscript управление терминалом *)
(* Хотя в Linux этот пример и не работает... *)
uses linux,stdio;

var
  dattr:termios;


procedure script(mfd:longint);
var
  nread, ofile:longint;
  _set, master:fdset;
  attr:termios;
  buf:array [0..511] of char;
begin
  (* Перевести дисциплину линии связи в режим прямого доступа *)
  tcgetattr (0, attr);
  attr.c_cc[VMIN] := 1;
  attr.c_cc[VTIME] := 0;
  attr.c_lflag := attr.c_lflag and not (ISIG or ECHO or ICANON);
  tcsetattr (0, TCSAFLUSH, attr);

  (* Открыть выходной файл *)
  ofile := fdopen ('output', Open_CREAT or Open_WRONLY or Open_TRUNC, octal(0666));

  (* Задать битовые маски для системного вызова select *)
  FD_ZERO (master);
  FD_SET (0, master);
  FD_SET (mfd, master);

  (* Вызов select осуществляется без таймаута,
   * и будет заблокирован до наступления события. *)
  _set := master;
  while select (mfd + 1, @_set, nil, nil, nil) > 0 do
  begin
    (* Проверить стандартный ввод *)
    if FD_ISSET (0, _set) then
    begin
      nread := fdread (0, buf, 512);
      fdwrite (mfd, buf, nread);
    end;
    (* Проверить главное устройство *)
    if FD_ISSET (mfd, _set) then
    begin
      nread := fdread (mfd, buf, 512);
      write (ofile, buf, nread);
      write (1, buf, nread);
    end;
    _set := master;
  end;
end;

 
procedure runshell (sfd:longint);
begin
  setpgrp;
  dup2 (sfd, 0);
  dup2 (sfd, 1);
  dup2 (sfd, 2);
  execl ('/bin/sh -i');
end;


function pttyopen (var masterfd, slavefd:longint):integer;
var
  slavenm:pchar;
begin
  (* Открыть псевдотерминал -
   * получить дескриптор файла главного устройства *)
  masterfd := fdopen ('/dev/ptmx', Open_RDWR);
  if masterfd = -1 then
  begin
    pttyopen:=-1;
    exit;
  end;
  (* Изменить права доступа для ведомого устройства *)
  if grantpt (masterfd) = -1 then
  begin
    fdclose (masterfd);
    pttyopen:=-2;
    exit;
  end;
  (* Разблокировать ведомое устройство, связанное с mfd *)
  if unlockpt (masterfd) = -1 then
  begin
    fdclose (masterfd);
    pttyopen:=-3;
    exit;
  end;
  (* Получить имя ведомого устройства и затем открыть его *)
  slavenm := ptsname (masterfd);
  if slavenm = nil then
  begin
    fdclose (masterfd);
    pttyopen:=-4;
    exit;
  end;
  slavefd := fdopen (slavenm, Open_RDWR);
  if slavefd = -1 then
  begin
    fdclose (masterfd);
    pttyopen:=-5;
    exit;
  end;
  (* Создать дисциплину линии связи *)
  ioctl (slavefd, I_PUSH, pchar('ptem'));
  if linuxerror>0 then
  begin
    fdclose (masterfd);
    fdclose (slavefd);
    pttyopen:=-6;
    exit;
  end;
  ioctl (slavefd, I_PUSH, pchar('ldterm'));
  if linuxerror>0 then
  begin
    fdclose (masterfd);
    fdclose (slavefd);
    pttyopen:=-7;
    exit;
  end;
  pttyopen:=1;
end;

 
procedure catch_child (signo:integer);cdecl;
begin
  tcsetattr (0, TCSAFLUSH, dattr);
  halt (0);
end;


var
  act:sigactionrec;
  mfd, sfd:longint;
  err:integer;
  buf:array [0..511] of char;
  mask:sigset_t;
begin

  (* Сохранить текущие установки терминала *)
  tcgetattr (0, dattr);
  (* Открыть псевдотерминал *)
  err := pttyopen (mfd, sfd);
  if err <> 1 then
  begin
    writeln (stderr, 'pttyopen: ', err);
    perror ('Ошибка при открытии псевдотерминала');
    halt (1);
  end;
  (* Установить обработчик сигнала SIGCHLD *)
  act.handler.sh := @catch_child;
  sigfillset (@mask);
  act.sa_mask:=mask.__val[0];
  sigaction (SIGCHLD, @act, nil);
  (* Создать процесс оболочки *)
  case fork of
    -1:			(* ошибка *)
    begin
      perror ('Ошибка вызова оболочки');
      halt (2);
    end;
    0:			(* дочерний процесс *)
    begin
      fdclose (mfd);
      runshell (sfd);
    end;
    else		(* родительский процесс *)
    begin
      fdclose (sfd);
      script (mfd);
    end;
  end;
end.
