paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 15:19:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Very aggressive vcsa detection

Browse Source 
git-svn-id: trunk@2349 -
This commit is contained in:
daniel 2006-01-27 10:28:58 +00:00
parent 45d159eaad
commit 44ee4f6a39
1 changed files with 39 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
utils/grab_vcsa.pp
View File

@ -1,5 +1,7 @@
program grab_vcsa;
{$I-}
{
This file is part of the Free Pascal run time library.
Copyright (c) 2005 by Daniël Mantione
@ -59,26 +61,55 @@ const result_success=0;
result_not_owner_error=5;
var thistty:string;
vcs,vcsa:string;
tty,vcs,vcsa:string;
ttystat:stat;
s:string[15];
c:char;
pid,parent,dummy:integer;
device:longint;
f:text;
found_vcsa:boolean;
begin
exitcode:=result_not_on_console;
thistty:=ttyname(stdinputhandle);
if isatty(stdinputhandle)=1 then
begin
{ running on a tty, find out whether locally or remotely }
if (length(thistty)>=9) and
(copy(thistty,1,8)='/dev/tty') and
(thistty[9] in ['0'..'9']) then
pid:=fpgetpid;
repeat
str(pid,s);
assign(f,'/proc/'+s+'/stat');
reset(f);
if ioresult<>0 then
break;
read(f,dummy);
read(f,c);
repeat
read(f,c);
until c=' ';
repeat
read(f,c);
until c=' ';
read(f,pid);
read(f,dummy);
read(f,dummy);
read(f,device);
close(f);
if device=0 then
break; {Not attached to a terminal, i.e. an xterm.}
found_vcsa:=device and $ffffff00=$00000400; {/dev/tty*}
until found_vcsa;
if found_vcsa then
begin
{We are running on the Linux console}
if fpstat(thistty,ttystat)<>0 then
str(device and $000000ff,s);
tty:='/dev/tty'+s;
if fpstat(tty,ttystat)<>0 then
halt(result_stat_error);
if ttystat.uid<>fpgetuid then
halt(result_not_owner_error);
vcs:='/dev/vcs'+copy(thistty,9,255);
vcsa:='/dev/vcsa'+copy(thistty,9,255);
vcs:='/dev/vcs'+s;
vcsa:='/dev/vcsa'+s;
{Change owner and group to that of /dev/tty??.}
if fpchown(vcs,ttystat.uid,ttystat.gid)<>0 then