* Fix bug ID #0035596: better detection of vcs device

git-svn-id: trunk@42766 -
This commit is contained in:
michael 2019-08-23 06:45:11 +00:00
parent 707e05d131
commit ee6c426e05

View File

@ -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