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): string;
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;

implementation

uses
  process;

var _cpuLastUsed,_cpuLastIdle: int64;

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): string;
var
  name: string;
begin
  result:=s;
  while pos('${',result)>0 do begin
    s:=erstesArgument(result,'${',false);
    name:=erstesArgument(result,'}',false);
    result:=s+GetEnvironmentVariable(name)+result;
  end;
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:                   string;
  i,j,ebene,iStart,iStopp,insOff: longint;
begin
  i:=0;
  while i<sa.count do
    if pos('{',sa[i])>0 then begin
      s:=sa[i];
      start:=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 '''+sa[i]+''' 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 '''+sa[i]+''' 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;

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+'''!');
end;

begin
  _cpuLastUsed:=0;
  _cpuLastIdle:=0;
  cpuUtilization;
end.