mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 10:09:20 +02:00
* Fix bug ID #0035596: better detection of vcs device
git-svn-id: trunk@42766 -
This commit is contained in:
parent
707e05d131
commit
ee6c426e05
@ -82,73 +82,59 @@ end;
|
|||||||
procedure detect_linuxvcs;
|
procedure detect_linuxvcs;
|
||||||
|
|
||||||
var f:text;
|
var f:text;
|
||||||
f_open : boolean;
|
fields:array [0..60] of int64;
|
||||||
c,pc:char;
|
fieldct,i:integer;
|
||||||
pid,cpid,dummy:longint;
|
pid,ppid:longint;
|
||||||
device:dword;
|
magnitude:int64;
|
||||||
s:string[15];
|
s:string[15];
|
||||||
|
statln:ansistring;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{Extremely aggressive VCSA detection. Works even through Midnight
|
{Extremely aggressive VCSA detection. Works even through Midnight
|
||||||
Commander. Idea from the C++ Turbo Vision project, credits go
|
Commander. Idea from the C++ Turbo Vision project, credits go
|
||||||
to Martynas Kunigelis <algikun@santaka.sc-uni.ktu.lt>.}
|
to Martynas Kunigelis <algikun@santaka.sc-uni.ktu.lt>.}
|
||||||
pid:=fpgetpid;
|
pid:=fpgetpid;
|
||||||
f_open:=false;
|
|
||||||
{$push}
|
|
||||||
{$I-}
|
|
||||||
{$R-}
|
|
||||||
repeat
|
repeat
|
||||||
cpid:=pid;
|
|
||||||
str(pid,s);
|
str(pid,s);
|
||||||
assign(f,'/proc/'+s+'/stat');
|
assign(f, '/proc/'+s+'/stat');
|
||||||
|
{$I-}
|
||||||
reset(f);
|
reset(f);
|
||||||
if ioresult<>0 then
|
{$I+}
|
||||||
exit;
|
|
||||||
f_open:=true;
|
|
||||||
{ from here we can discard I/O errors, as long as we avoid
|
|
||||||
infinite loops }
|
|
||||||
{ first number is pid }
|
|
||||||
dummy:=0;
|
|
||||||
read(f,dummy);
|
|
||||||
if dummy<>pid then
|
|
||||||
exit;
|
|
||||||
{ after comes the name of the binary within (), look for closing brace followed by space }
|
|
||||||
c:=#0;
|
|
||||||
repeat
|
|
||||||
pc:=c;
|
|
||||||
read(f,c);
|
|
||||||
if ioresult<>0 then
|
if ioresult<>0 then
|
||||||
break;
|
break;
|
||||||
until (pc=')') and (c=' ');
|
readln(f, statln);
|
||||||
{ now comes the state letter }
|
|
||||||
repeat
|
|
||||||
read(f,c);
|
|
||||||
if ioresult<>0 then
|
|
||||||
break;
|
|
||||||
until c=' ';
|
|
||||||
{ parent pid }
|
|
||||||
pid:=-1;
|
|
||||||
read(f,pid);
|
|
||||||
{ process group }
|
|
||||||
read(f,dummy);
|
|
||||||
{ session }
|
|
||||||
read(f,dummy);
|
|
||||||
{ device number }
|
|
||||||
device:=0;
|
|
||||||
read(f,device);
|
|
||||||
close(f);
|
close(f);
|
||||||
f_open:=false;
|
magnitude := 1;
|
||||||
if (device and $ffffffc0)=$00000400 then {/dev/tty*}
|
fieldct := 0;
|
||||||
|
fields[fieldct] := 0;
|
||||||
|
for i := high(statln) downto low(statln) do
|
||||||
begin
|
begin
|
||||||
vcs_device:=device and $3f;
|
case statln[i] of
|
||||||
|
'-': magnitude := -1;
|
||||||
|
'0'..'9': begin
|
||||||
|
fields[fieldct] := fields[fieldct]
|
||||||
|
+ (magnitude * (ord(statln[i]) - ord('0')));
|
||||||
|
magnitude := magnitude * 10;
|
||||||
|
end;
|
||||||
|
' ': begin
|
||||||
|
magnitude := 1;
|
||||||
|
fieldct := fieldct + 1;
|
||||||
|
fields[fieldct] := 0;
|
||||||
|
end;
|
||||||
|
else
|
||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
until (device=0) {Not attached to a terminal, i.e. an xterm.}
|
end;
|
||||||
|
ppid := pid;
|
||||||
|
pid := fields[fieldct - 1];
|
||||||
|
if (fields[fieldct - 4] and $ffffffc0) = $00000400 then {/dev/tty*}
|
||||||
|
begin
|
||||||
|
vcs_device:=fields[fieldct - 4] and $3f;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
until (fields[fieldct - 4]=0) {Not attached to a terminal, i.e. an xterm.}
|
||||||
or (pid=-1)
|
or (pid=-1)
|
||||||
or (cpid=pid);
|
or (ppid=pid);
|
||||||
if f_open then
|
|
||||||
close(f);
|
|
||||||
{$pop}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
Loading…
Reference in New Issue
Block a user