path: root/systemunit.pas

unit systemunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Math, lowlevelunit, mystringlistunit;

function cpuUtilization: extended;
function numCpus: int64;
function momentanFreieCpus: int64;
function belegterSpeicher: int64;
function minCache: int64;
function shellSubst(s: string; env: tMyStringList = nil): string;
function homeVerzeichnis: string; overload;
function homeVerzeichnis(user: string): string; overload;
function shellExpand(s: string): string; overload;
procedure shellExpand(s: string; out sa: tMyStringList); overload;
procedure shellExpand(var sa: tMyStringList); overload;
function mkTemp(s: string): string;
function myReadLink(s: string): string;
function pwd: string;
function argMax: longestOrdinal; inline;

implementation

uses
  process;

var
  _cpuLastUsed,_cpuLastIdle: int64;
  _argMax:                   longestOrdinal;

function cpuUtilization: extended;
var
  procstat:  textFile;
  s:         string;
  used,idle: int64;
  i:         integer;
begin
  result:=0;
  s:='';
  assignFile(procstat,'/proc/stat');
  reset(procstat);
  while not eof(procstat) do begin
    readln(procstat,s);
    if startetMit('cpu ',s) then break;
    s:='';
  end;
  closeFile(procstat);
  if s='' then exit;
  used:=0;
  idle:=0;
  for i:=0 to 3 do begin
    used:=used+idle;
    idle:=strToInt(erstesArgument(s));
  end;
  result:=(used-_cpuLastUsed)/max(1,used-_cpuLastUsed + idle-_cpuLastIdle);
  _cpuLastUsed:=used;
  _cpuLastIdle:=idle;
end;

function numCpus: int64;
var
  procstat:  textFile;
  s:         string;
begin
  result:=0;
  s:='';
  assignFile(procstat,'/proc/stat');
  reset(procstat);
  while not eof(procstat) do begin
    readln(procstat,s);
    if (not startetMit('cpu ',s)) and
       startetMit('cpu',s) then
      inc(result);
  end;
  closeFile(procstat);
end;

function momentanFreieCpus: int64;
begin
  result:=floor(numCpus*(1-cpuUtilization));
end;

function belegterSpeicher: int64;
var
  f:    textFile;
  s:    string;
begin
  s:='/proc/'+intToStr(getProcessId)+'/smaps';
  result:=0;
  if not fileExists(s) then
    exit;
  assignFile(f,s);
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    if startetMit('Rss:',s) and (endetMit('kB',s) or endetMit('KB',s)) then
      result:=result+strToInt(s);
  end;
  closeFile(f);
end;

function minCache: int64;
var
  f:    textFile;
  s:    string;
begin
  s:='/proc/cpuinfo';
  result:=0;
  if not fileExists(s) then exit;
  assignFile(f,s);
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    if startetMit('cache',s) and startetMit('size',s) and startetMit(':',s) and (endetMit('KB',s) or endetMit('kB',s)) then begin
      if result=0 then
        result:=strToInt(s)
      else
        result:=min(result,strToInt(s));
    end;
  end;
  closeFile(f);
end;

function shellSubst(s: string; env: tMyStringList = nil): string;
var
  name:     string;
  i:        longint;
  gefunden: boolean;
begin
  result:='';
  while pos('${',s)>0 do begin
    result:=result+erstesArgument(s,'${',false);
    name:=erstesArgument(s,'}',false);
    gefunden:=false;
    if assigned(env) then
      for i:=0 to env.count-1 do
        if leftStr(env[i],length(s)+1) = s+'=' then begin
          result:=result+rightStr(env[i],length(env[i])-length(s)-1);
          gefunden:=true;
          break;
        end;
    if not gefunden then
      result:=result+getEnvironmentVariable(name);
  end;
  result:=result+s;
end;

function homeVerzeichnis: string;
begin
  result:=shellSubst('${HOME}');
end;

function homeVerzeichnis(user: string): string;
var
  params: array of string;
  i:      longint;
begin
  setLength(params,2);
  params[0]:='passwd';
  params[1]:=user;
  if runCommand('getent',params,result) then begin
    for i:=0 to 4 do
      erstesArgument(result,':',false);
    result:=erstesArgument(result,':',false);
  end
  else
    result:='';
end;

function shellExpand(s: string): string;
var
  sa: tMyStringList;
  i:  longint;
begin
  shellExpand(s,sa);
  result:='';
  for i:=0 to sa.count-1 do
    result:=result+sa[i]+' ';
  delete(result,length(result),1);
  sa.free;
end;

procedure shellExpand(s: string; out sa: tMyStringList);
begin
  sa:=tMyStringList.create;
  while s<>'' do
    sa.add(erstesArgument(s));
  shellExpand(sa);
end;

procedure shellExpand(var sa: tMyStringList);
var
  start,ende,s,original,praefix:  string;
  i,j,ebene,iStart,iStopp,insOff: longint;
begin
  i:=0;
  while i<sa.count do begin
    original:=sa[i];
    s:=original;
    praefix:='';
    while pos('{',s+'{') > pos('''',s+'''') do begin
      j:=pos('''',s+'''');
      praefix:=praefix + leftStr(s,j);
      delete(s,1,j);
      j:=pos('''',s+'''');
      praefix:=praefix + leftStr(s,j);
      delete(s,1,j);
    end;
    if pos('{',s)>0 then begin
      start:=praefix+erstesArgument(s,'{',false);
      j:=1;
      ebene:=0;
      while (j<=length(s)) and ((s[j]<>'}') or (ebene>0)) do begin
        case s[j] of
          '{': inc(ebene);
          '}': dec(ebene);
        end{of case};
        inc(j);
      end;
      if (ebene<>0) or (j>length(s)) then
        fehler('Geschweifte Klammern sind in '''+original+''' nicht ausgewogen!');

      ende:=rightStr(s,length(s)-j);
      s:=leftStr(s,j-1)+',';

      sa.delete(i);

      iStart:=low(longint);
      insOff:=0;
      j:=1;
      ebene:=0;
      while (j<=length(s)) do begin
        case s[j] of
          '{': inc(ebene);
          '}': dec(ebene);
          '.':
            if (ebene=0) and (copy(s,j,2)='..') then begin
              if iStart<>low(longint) then
                fehler('''..'' darf nicht mehrmals hintereinander auftauchen - in '''+original+''' ist das aber der Fall!');
              iStart:=strToInt(trim(leftStr(s,j-1)));
              delete(s,1,j+1);
              j:=1;
              continue;
            end;
          ',':
            if ebene=0 then begin
              if iStart=low(longint) then begin // keine Zähliteration
                sa.insert(i+insOff,start+leftStr(s,j-1)+ende);
                inc(insOff);
                delete(s,1,j);
                j:=1;
                continue;
              end
              else begin                        // eine Zähliteration
                iStopp:=strToInt(trim(leftStr(s,j-1)));
                delete(s,1,j);
                for j:=iStart to iStopp do
                  sa.insert(i+insOff+j-iStart,start+intToStr(j)+ende);
                inc(insOff,iStopp-iStart+1);
                iStart:=low(longint);
                j:=1;
                continue;
              end;
            end;
        end{of case};
        inc(j);
      end;
    end
    else
      inc(i);
  end;
  for i:=0 to sa.count-1 do begin
    if leftStr(sa[i],1)<>'~' then
      continue;
    s:=sa[i];
    delete(s,1,1);
    if (s='') or (leftStr(s,1)='/') or (leftStr(s,1)=' ') then
      s:=homeVerzeichnis+s
    else begin
      if pos(' ',s+' ')<pos('/',s+'/') then
        ende:=' '
      else
        ende:='/';
      start:=erstesArgument(s,ende,false);
      start:=homeVerzeichnis(start);
      if start='' then
        continue;
      s:=start+ende+s;
    end;
    sa[i]:=s;
  end;
end;

function mkTemp(s: string): string;
var
  args: array of string;
begin
  setLength(args,0);
  while s<>'' do begin
    setLength(args,length(args)+1);
    args[length(args)-1]:=erstesArgument(s);
  end;
  result:='';
  if not runCommand('mktemp',args,result) then
    raise exception.create('Fehler beim Ausführen von ''mktemp '+s+'''!');
  result:=trim(result);
end;

function myReadLink(s: string): string;
var
  args: array of string;
begin
  setLength(args,3);
  args[0]:='-f';
  args[1]:='-n';
  args[2]:=s;
  result:='';
  if not runCommand('readlink',args,result) then
    raise exception.create('Fehler beim Ausführen von ''readlink -f -n '+s+'''!');
  result:=trim(result);
end;

function pwd: string;
var
  args: array of string;
begin
  setLength(args,0);
  result:='';
  if not runCommand('pwd',args,result) then
    raise exception.create('Fehler beim Ausführen von ''pwd''!');
  result:=trim(result);
end;

function argMax: longestOrdinal;
var
  args: array of string;
  s:    string;
begin
  if _argMax<0 then begin
    setLength(args,1);
    args[0]:='ARG_MAX';
    if not runCommand('getconf',args,s) then
      raise exception.create('Fehler beim Ausführen von ''getconf ARG_MAX''!');
    _argMax:=strToInt(trim(s));
  end;
  result:=_argMax;
end;

begin
  _cpuLastUsed:=0;
  _cpuLastIdle:=0;
  _argMax:=-1;
  cpuUtilization;
end.