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

(* рТПГЕДХТБ ttyopen - ЧЩЪПЧ fdopen У ЙОФЕТЧБМПН ПЦЙДБОЙС *)
uses stdio,linux;

const
TIMEOUT=10;
timeout_flag:boolean=FALSE;
termname:pchar='';

procedure settimeout(value:longint);cdecl;
begin
writeln(stderr, 'рТЕЧЩЫЕОП ЧТЕНС ПЦЙДБОЙС ', termname);
timeout_flag := TRUE;
end;


function ttyopen(filename:pchar; flags:longint):longint;
var
fd:longint;
act, oact:sigactionrec;
mask:sigset_t;
begin
fd := -1;

termname := filename;

(* хУФБОПЧЙФШ ЖМБЗ ФБКНБХФБ *)
timeout_flag := FALSE;

(* хУФБОПЧЙФШ ПВТБВПФЮЙЛ УЙЗОБМБ SIGALRM *)
act.handler.sh := @settimeout;
sigfillset(@mask);
act.sa_mask:=mask.__val[0];
sigaction(SIGALRM, @act, @oact);

alarm(TIMEOUT);

fd := fdopen(filename, flags);

(* уВТПУ ХУФБОПЧПЛ *)
alarm(0);
sigaction(SIGALRM, @oact, @act);
if timeout_flag then
ttyopen:=-1
else
ttyopen:=0;
end;

var
fd:longint;
begin
fd:=ttyopen('/dev/tty',Open_RDWR);
if fd<>-1 then
begin
fdwrite(fd,'hello!'#$a,8);
fdclose(fd);
end
else
perror('пЫЙВЛБ ПФЛТЩФЙС ФЕТНЙОБМБ /dev/tty');
end.