path: root/komponenten.pas

unit komponenten;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Process;

type
  tBoolOperation = (boNot, boAnd, boOr, boMove, boSet, boClr);
  tBearbeitungsschritt = record
  case was: TBoolOperation of
    boNot,boSet,boClr: (womit: integer);
    boAnd,boOr:        (w1,w2: integer);
    boMove:            (Welches, wohin: integer);
  end;
  tBedingung = array of tBearbeitungsschritt;
  tLogEvent = procedure(s: string) of object;

  tTestAufgabe = class;

  tAufgabenThread = class(tThread)
  private
    _status:          byte;     // 0 = error; 1 = OK; 2 = disabled/unknown
    _beendet:         boolean;
    _besitzer:        tTestAufgabe;
    procedure _statusAenderung;
    procedure wStatus(s: byte);
  public
    beenden,warten:  boolean;
    fehlerIntervall,
      okIntervall:   longint;
    property status: byte
      read  _status
      write wStatus;
    property beendet: boolean read _beendet;
    constructor create(besitzer: tTestAufgabe);
    procedure execute; override;
    procedure ausfuehren; virtual; abstract;
  end;

  tTestAufgabe = class
  private
    _thread: tAufgabenThread;
    function rStatus: byte;
    procedure wOkIntervall(l: longint);
    procedure wFehlerIntervall(l: longint);
    procedure outerLog(s: string);
  public
    bedingung:                   tBedingung;
    fehlerNachricht:             string;
    statusAenderung:             tNotifyEvent;
    log:                         tLogEvent;
    ernst:                       boolean;
    property status: byte
      read rstatus;
    property okIntervall: longint
      write wOkIntervall;
    property fehlerIntervall: longint
      write wFehlerIntervall;
    constructor create;
    destructor destroy; override;
    function bedingungErfuellt(vorgaben: array of boolean): boolean;
    function aktivieren(vorgaben: array of boolean): boolean;
    function nimmParameter(s: string): boolean; virtual; abstract;
    procedure threadBeenden;
  end;

  tIpThread = class(tAufgabenThread)
  private
  public
    werSollIchSein,geraet: string;
    constructor create(besitzer: tTestAufgabe);
    procedure ausfuehren; override;
  end;

  tTestIp = class(tTestAufgabe)
  private
  public
    constructor create;
    function nimmParameter(s: string): boolean; override;
  end;

  tPingThread = class(tAufgabenThread)
  private
  public
    wen: string;
    constructor create(besitzer: tTestAufgabe);
    procedure ausfuehren; override;
  end;

  tTestPing = class(tTestAufgabe)
  private
  public
    constructor create;
    function nimmParameter(s: string): boolean; override;
  end;

  tRfcThread = class(tAufgabenThread)
  private
  public
    vergleichAuffrischen:  boolean;
    quelle,vergleich,cert: string;
    ipVer:                 char;
    constructor create(besitzer: tTestAufgabe);
    procedure ausfuehren; override;
  end;

  tRemoteFileCompare = class(tTestAufgabe)
  private
  public
    constructor create;
    function nimmParameter(s: string): boolean; override;
  end;

  tRfdThread = class(tAufgabenThread)
  private
  public
    quelle,cert: string;
    deltaT:      longint;
    constructor create(besitzer: tTestAufgabe);
    procedure ausfuehren; override;
  end;

  tRemoteFileDate = class(tTestAufgabe)
  private
  public
    constructor create;
    function nimmParameter(s: string): boolean; override;
  end;

function loeseLogischenTerm(s: string): tBedingung;

implementation

uses lowlevelunit, forms;


// logischer Term **************************************************************

function loeseLogischenTerm(s: string): tBedingung;
var
  i:           integer;
  t:           string;
  zahlenStack: array of integer;
begin
  t:='';
  setlength(result,0);
  setlength(zahlenStack,0);
  for i:=1 to length(s) do
    case s[i] of
      '0'..'9': t:=t+s[i];
      '-': begin
        setlength(result,length(result)+1);
        result[length(result)-1].was:=boNot;
        result[length(result)-1].womit:=zahlenStack[length(zahlenStack)-1];
        setlength(zahlenStack,length(zahlenStack)-1);
      end;
      '&': begin
        setlength(result,length(result)+1);
        result[length(result)-1].was:=boAnd;
        result[length(result)-1].w1:=zahlenStack[length(zahlenStack)-2];
        result[length(result)-1].w2:=zahlenStack[length(zahlenStack)-1];
        setlength(zahlenStack,length(zahlenStack)-2);
      end;
      '|','#': begin
        setlength(result,length(result)+1);
        result[length(result)-1].was:=boOr;
        result[length(result)-1].w1:=zahlenStack[length(zahlenStack)-2];
        result[length(result)-1].w2:=zahlenStack[length(zahlenStack)-1];
        setlength(zahlenStack,length(zahlenStack)-2);
      end;
      'c': begin
        setlength(result,length(result)+1);
        result[length(result)-1].was:=boClr;
        result[length(result)-1].womit:=zahlenStack[length(zahlenStack)-1];
        setlength(zahlenStack,length(zahlenStack)-1);
      end;
      's': begin
        setlength(result,length(result)+1);
        result[length(result)-1].was:=boSet;
        result[length(result)-1].womit:=zahlenStack[length(zahlenStack)-1];
        setlength(zahlenStack,length(zahlenStack)-1);
      end;
      '~': begin
        setlength(result,length(result)+1);
        result[length(result)-1].was:=boMove;
        result[length(result)-1].welches:=zahlenStack[length(zahlenStack)-2];
        result[length(result)-1].wohin:=zahlenStack[length(zahlenStack)-1];
        setlength(zahlenStack,length(zahlenStack)-2);
      end;
      '_': begin
        setlength(zahlenStack,length(zahlenStack)+1);
        zahlenStack[length(zahlenStack)-1]:=strtoint(t);
        t:='';
      end;
    end{of case};
end;

// tAufgabenThread *************************************************************

constructor tAufgabenThread.create(besitzer: tTestAufgabe);
begin
  inherited create(true);
  _besitzer:=besitzer;
  _status:=2;
  _beendet:=false;
  fehlerIntervall:=60;
  okIntervall:=60;
  beenden:=false;
  warten:=true;
  suspended:=false;
end;

procedure tAufgabenThread._statusAenderung;
begin
  if assigned(_besitzer.statusAenderung) then
    _besitzer.statusAenderung(_besitzer);
end;

procedure tAufgabenThread.wStatus(s: byte);
begin
  if _status=s then exit;
  _status:=s;
  synchronize(@_statusAenderung);
end;

procedure tAufgabenThread.execute;
var
  i: longint;
begin
  while not beenden do begin
    while warten do
      sleep(10);
    ausfuehren;
    if beenden then
      continue;
    i:=0;
    if _status=1 then
      for i:=0 to okIntervall-1 do begin
        if beenden then break;
        sleep(100);
      end
    else
      for i:=0 to fehlerIntervall-1 do begin
        if beenden then break;
        sleep(100);
      end;
  end;
  _beendet:=true;
end;

// tTestAufgabe ****************************************************************

constructor tTestAufgabe.create;
begin
  inherited create;
  setlength(bedingung,0);
  fehlerNachricht:='leer';
  statusAenderung:=nil;
  log:=nil;
  ernst:=true;
end;

destructor tTestAufgabe.destroy;
begin
  _thread.free;
  setlength(bedingung,0);
  inherited destroy;
end;

function tTestAufgabe.rStatus: byte;
begin
  result:=_thread.status;
end;

procedure tTestAufgabe.wOkIntervall(l: longint);
begin
  _thread.okIntervall:=l;
end;

procedure tTestAufgabe.wFehlerIntervall(l: longint);
begin
  _thread.fehlerIntervall:=l;
end;

procedure tTestAufgabe.outerLog(s: string);
begin
  if assigned(log) then begin
    if self is tTestIP then
      s:=s+' (testIP)';
    if self is tTestPing then
      s:=s+' (testPing)';
    if self is tRemoteFileCompare then
      s:=s+' (remoteFileCompare)';
    if self is tRemoteFileDate then
      s:=s+' (remoteFileDate)';
    log(s);
  end;
end;

function tTestAufgabe.bedingungErfuellt(vorgaben: array of boolean): boolean;
var
  reg: array of boolean;
  i:   integer;
begin
  setlength(reg,length(vorgaben));
  for i:=0 to length(vorgaben)-1 do
    reg[i]:=vorgaben[i];
  for i:=0 to length(bedingung)-1 do
    case bedingung[i].was of
      boNot:
        reg[bedingung[i].womit]:=not reg[bedingung[i].womit];
      boSet: begin
        if bedingung[i].womit>=length(reg) then
          setlength(reg,bedingung[i].womit+1);
        reg[bedingung[i].womit]:=true;
      end;
      boClr: begin
        if bedingung[i].womit>=length(reg) then
          setlength(reg,bedingung[i].womit+1);
        reg[bedingung[i].womit]:=false;
      end;
      boAnd:
        reg[bedingung[i].w1]:=reg[bedingung[i].w1] and reg[bedingung[i].w2];
      boOr:
        reg[bedingung[i].w1]:=reg[bedingung[i].w1] or reg[bedingung[i].w2];
      boMove: begin
        if bedingung[i].wohin>=length(reg) then
          setlength(reg,bedingung[i].wohin+1);
        reg[bedingung[i].wohin]:=reg[bedingung[i].welches];
      end;
    end{of Case};
  result:=reg[0];
end;

function tTestAufgabe.aktivieren(vorgaben: array of boolean): boolean;
var
  tmp: boolean;
begin
  tmp:=not bedingungErfuellt(vorgaben);
  result:=tmp xor _thread.warten;
  if result then
    _thread.warten:=tmp;
end;

procedure tTestAufgabe.threadBeenden;
begin
  _thread.beenden:=true;
end;

// tTestIpThread ***************************************************************

constructor tIpThread.create(besitzer: tTestAufgabe);
begin
  inherited create(besitzer);
  fillchar(werSollIchSein,sizeof(werSollIchSein),#0);
  setlength(werSollIchSein,0);
  fillchar(geraet,sizeof(geraet),#0);
  setlength(geraet,0);
end;

procedure tIpThread.ausfuehren;
var
  ausgabe:   string;
  argumente: array of string;
begin
  ausgabe:='';
  setlength(argumente,4);
  argumente[0]:='addr';
  argumente[1]:='show';
  argumente[2]:='dev';
  argumente[3]:=geraet;
  if (not runCommand('/sbin/ip',argumente,ausgabe)) or (pos('inet',ausgabe)=0) then begin
    status:=0;
    setlength(argumente,0);
    exit;
  end;
  delete(ausgabe,1,pos('inet',ausgabe)-1);
  status:=byte(pos('inet '+werSollIchSein+' ',ausgabe)=1);
  setlength(argumente,0);
end;

// tTestIp *********************************************************************

constructor tTestIp.create;
begin
  inherited create;
  _thread:=tIpThread.create(self);
end;

function tTestIp.nimmParameter(s: string): boolean;
var
  i,j:    longint;
begin
  result:=false;
  (_thread as tIpThread).geraet:=erstesArgument(s,':');
  (_thread as tIpThread).werSollIchSein:=s;
  if pos('/',s)=0 then exit;
  s[pos('/',s)]:='.';
  s:=s+'.';
  for j:=0 to 4 do begin
    i:=pos('.',s);
    if (i<2) or (i>4) then exit;
    for i:=1 to pos('.',s)-1 do
      if not (s[i] in ['0'..'9']) then
        exit;
    delete(s,1,pos('.',s));
  end;
  result:=length(s)=0;
end;

// tPingThread *****************************************************************

constructor tPingThread.create(besitzer: tTestAufgabe);
begin
  inherited create(besitzer);
  fillchar(wen,sizeof(wen),#0);
  setlength(wen,0);
end;

procedure tPingThread.ausfuehren;
var
  ausgabe:   string;
  argumente: array of string;
begin
  ausgabe:='';
  setlength(argumente,2);
  argumente[0]:='-c1';
  argumente[1]:=wen;
  status:=byte(runCommand('ping',argumente,ausgabe) and (pos('1 packets transmitted, 1 received, 0% packet loss, time',ausgabe)<>0));
  setlength(argumente,0);
end;

// tTestPing *******************************************************************

constructor tTestPing.create;
begin
  inherited create;
  _thread:=tPingThread.create(self);
end;

function tTestPing.nimmParameter(s: string): boolean;
begin
  (_thread as tPingThread).wen:=s;
  result:=true;
end;

// tRfcThread ******************************************************************

constructor tRfcThread.create(besitzer: tTestAufgabe);
begin
  inherited create(besitzer);
  vergleichAuffrischen:=false;
  fillchar(quelle,sizeof(quelle),#0);
  setlength(quelle,0);
  fillchar(vergleich,sizeof(vergleich),#0);
  setlength(vergleich,0);
  fillchar(cert,sizeof(cert),#0);
  setlength(cert,0);
  ipVer:=#0;
end;

procedure tRfcThread.ausfuehren;
var
  argumente:   array of string;
  ausgabe,buf: string;
  f:           file;
begin
  setlength(argumente,3+byte(ipVer in ['4','6'])+2*byte(cert<>''));
  argumente[0]:='-o';
  argumente[1]:='-';
  if ipVer in ['4','6'] then
    argumente[2]:='-'+ipVer;
  if cert<>'' then begin
    argumente[2+byte(ipVer in ['4','6'])]:='--cacert';
    argumente[3+byte(ipVer in ['4','6'])]:=cert;
  end;
  argumente[2+byte(ipVer in ['4','6'])+2*byte(cert<>'')]:=quelle;
  ausgabe:='';
  if not runCommand('curl',argumente,ausgabe) then begin
    status:=0;
    setlength(argumente,0);
    exit;
  end;
  setlength(argumente,0);
  assignFile(f,vergleich);
  if vergleichAuffrischen then begin
    rewrite(f,1);
    blockwrite(f,ausgabe[1],length(ausgabe));
    close(f);
  end;
  reset(f,1);
  if fileSize(f)<>length(ausgabe) then begin
    status:=0;
    closeFile(f);
    exit;
  end;
  setlength(buf,length(ausgabe));
  blockRead(f,buf[1],length(buf));
  closeFile(f);
  status:=byte(ausgabe=buf);
end;

// tRemoteFileCompare **********************************************************

function tRemoteFileCompare.nimmParameter(s: string): boolean;
begin
  result:=false;
  with _thread as tRfcThread do begin
    vergleichAuffrischen:=startetMit('*',s);
    if pos(';',s)=0 then exit;
    vergleich:=erstesArgument(s,';');
    if startetMit('4',s) then
      ipVer:='4'
    else if startetMit('6',s) then
      ipVer:='6';
    if pos(';',s)=0 then cert:=''
    else cert:=erstesArgument(s,';');
    quelle:=s;
    if pos('/',vergleich)<>1 then
      vergleich:=extractFilePath(application.exeName)+vergleich;
    if (cert<>'') and (pos('/',cert)<>1) then
      cert:=extractFilePath(application.exeName)+cert;
    result:=fileexists(vergleich);
    if (cert<>'') and not fileexists(cert) then
      result:=false;
  end;
end;

constructor tRemoteFileCompare.create;
begin
  inherited create;
  _thread:=tRfcThread.create(self);
end;

// tRfdThread ******************************************************************

constructor tRfdThread.create(besitzer: tTestAufgabe);
begin
  inherited create(besitzer);
  fillchar(quelle,sizeof(quelle),#0);
  setlength(quelle,0);
  fillchar(cert,sizeof(cert),#0);
  setlength(cert,0);
  deltaT:=0;
end;

procedure tRfdThread.ausfuehren;
var
  argumente: array of string;
  ausgabe:   string;
  rD,lD:     longint;
  qURI,s:    string;
begin
  setlength(argumente,3+2*byte(cert<>'')+2*byte(pos('#',quelle)>0));
  argumente[0]:='-o';
  argumente[1]:='-';
  if cert<>'' then begin
    argumente[2]:='--cacert';
    argumente[3]:=cert;
  end;
  qURI:=copy(quelle,pos('#',quelle)+1,length(quelle));
  argumente[2+2*byte(cert<>'')+2*byte(pos('#',quelle)>0)]:=qURI;
  if pos('#',quelle)>0 then begin
    argumente[2+2*byte(cert<>'')]:='--resolve';
    if copy(qURI,1,7)='http://' then
      s:=':80:'
    else
      s:=':443:';
    delete(qURI,1,pos('://',qURI)+2);
    s:=copy(qURI,1,pos('/',qURI)-1)+s+copy(quelle,1,pos('#',quelle)-1);
    argumente[2+2*byte(cert<>'')+1]:=s;
  end;
  ausgabe:='';
  if not runCommand('curl',argumente,ausgabe) then begin
    status:=0;
    setlength(argumente,0);
    exit;
  end;
  try
    rD:=strtoint(trim(ausgabe));
  except
    status:=0;
    setlength(argumente,0);
    exit;
  end;
  setlength(argumente,1);
  argumente[0]:='+%s';
  if not runCommand('date',argumente,ausgabe) then begin
    status:=0;
    setlength(argumente,0);
    exit;
  end;
  setlength(argumente,0);
  try
    lD:=strtoint(trim(ausgabe));
  except
    status:=0;
    exit;
  end;
  status:=byte((lD>=rD) and (rD+deltaT>=lD));
end;

// tRemoteFileDate *************************************************************

constructor tRemoteFileDate.create;
begin
  inherited create;
  _thread:=tRfdThread.create(self);
end;

function tRemoteFileDate.nimmParameter(s: string): boolean;
begin
  result:=false;
  with _thread as tRfdThread do begin
    if pos(';',s)=0 then exit;
    try
      deltaT:=strToInt(erstesArgument(s,';'));
    except
      exit;
    end;
    if pos(';',s)=0 then cert:=''
    else cert:=erstesArgument(s,';');
    quelle:=s;
    if (cert<>'') and (pos('/',cert)=0) then
      cert:=extractFilePath(application.exeName)+cert;
    result:=(cert='') or fileexists(cert);
  end;
end;

end.