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 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): string; var name: string; begin result:=''; while pos('${',s)>0 do begin result:=result+erstesArgument(s,'${',false); name:=erstesArgument(s,'}',false); 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: string; i,j,ebene,iStart,iStopp,insOff: longint; begin i:=0; while i0 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); 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+' ')'' 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.