{*******************************************************}
{                                                       }
{       ManagerRule                                     }
{                                                       }
{       Copyright (C) 2023 kku                          }
{                                                       }
{*******************************************************}

unit ManagerRule;

interface

uses
  Tocsg.Obj, System.SysUtils, System.Classes, Winapi.Windows,
  System.Generics.Collections, IdHTTP, IdSSLOpenSSL, IdIOHandler, superobject;

type
  TRuleType = (rtPattern, rtKeyword, rtExceptPattern, rtExceptKeyword, rtBrBlst); // ManagerPattern.pas에도 있음 변동사항 발생 시 주의
  TRuleSeverity = (rsLow, rsNormal, rsHigh);
  PRuleEnt = ^TRuleEnt;
  TRuleEnt = record
    sId,
    sRName,
    sRVal: String;
    nCnt: Integer;
    bAnd: Boolean;
    RType: TRuleType;
    RSeverity: TRuleSeverity;
  end;
  TRuleEntList = TList<PRuleEnt>;

  TManagerRule = class(TTgObject)
  private
    HTTP_: TIdHTTP;
    SSL_: TIdSSLIOHandlerSocketOpenSSL;
    RList_: TRuleEntList;
    procedure OnEntNotify(Sender: TObject; const Item: PRuleEnt; Action: TCollectionNotification);
  public
    Constructor Create;
    Destructor Destroy; override;

    function CountRule: Integer;
    function GetRuleFromId(sId: String): PRuleEnt;
    function GetRuleFromRName(sRName: String): PRuleEnt;
    function GetRuleNameFromId(sId: String): String;
    function GetRuleNamesFromIds(sIds: String): String;
    function GetRuleSearchStrFromIds(sIds: String): String;
    function GetRuleSearchStrFromIdsN(sIds: String): String; // 룰 코드가 아닌 이름으로 표시
    procedure DelRule(sId: String);
    procedure RefineRuleList(aList: TStringList);
    procedure Save;
    procedure Load;

    procedure UpdateRuleEnts(aO: ISuperObject);

    property RList: TRuleEntList read RList_;

  end;

implementation

uses
  Tocsg.Exception, ManagerService, Tocsg.Safe, Tocsg.Strings,
  Tocsg.Json, Tocsg.Path, GlobalDefine, Tocsg.Convert;

{ TManagerRule }

Constructor TManagerRule.Create;

  procedure InitHttp;
  begin
    try
      SSL_ := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
      SSL_.SSLOptions.Method := sslvSSLv23;
      SSL_.SSLOptions.SSLVersions := [sslvTLSv1_2, sslvTLSv1_1, sslvTLSv1];

      HTTP_ := TIdHTTP.Create(nil);
      HTTP_.IOHandler := SSL_;
      with HTTP_ do
      begin
  //      HandleRedirects := true;
  //      Request.BasicAuthentication := true;
        Request.Clear;
        Request.UserAgent := 'Mozilla/5.0';
        Request.ContentType := 'application/json; charset=utf-8'; //'application/xml';
        Request.Accept      := 'application/json; charset=utf-8';
        Request.Charset     := 'utf-8';
//        Request.Connection  := 'Keep-Alive';
//        Request.CustomHeaders.Values['Keep-Alive'] := 'timeout=300, max=100';
        Request.Connection  := 'close';
        HTTPOptions := HTTPOptions - [hoKeepOrigProtocol];
        ConnectTimeout := 3000;
        ReadTimeout := 10000;
      end;
    except
      on E: Exception do
        ETgException.TraceException(Self, E, 'Create() .. InitHttp()');
    end;
  end;

begin
  Inherited Create;
  InitHttp;
  RList_ := TRuleEntList.Create;
  RList_.OnNotify := OnEntNotify;
  Load;
end;

Destructor TManagerRule.Destroy;
begin
  FreeAndNil(RList_);
  FreeAndNil(HTTP_);
  FreeAndNil(SSL_);
  Inherited;
end;

procedure TManagerRule.OnEntNotify(Sender: TObject; const Item: PRuleEnt; Action: TCollectionNotification);
begin
  if Action = cnRemoved then
    Dispose(Item);
end;

function TManagerRule.CountRule: Integer;
begin
  Result := RList_.Count;
end;

function TManagerRule.GetRuleFromId(sId: String): PRuleEnt;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to RList_.Count - 1 do
    if RList_[i].sId = sId then
    begin
      Result := RList_[i];
      exit;
    end;
end;

function TManagerRule.GetRuleFromRName(sRName: String): PRuleEnt;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to RList_.Count - 1 do
    if RList_[i].sRName = sRName then
    begin
      Result := RList_[i];
      exit;
    end;
end;

function TManagerRule.GetRuleNameFromId(sId: String): String;
var
  i: Integer;
begin
  Result := sId;
  for i := 0 to RList_.Count - 1 do
    if RList_[i].sId = sId then
    begin
      Result := RList_[i].sRName;
      exit;
    end;
end;

function TManagerRule.GetRuleNamesFromIds(sIds: String): String;
var
  IdList: TStringList;
  i, nPos: Integer;
  sId, sCnt: String;
begin
  Result := '';

  Guard(IdList, TStringList.Create);
  SplitString(sIds, ',', IdList);
  for i := 0 to IdList.Count - 1 do
  begin
    sId := IdList[i];
    nPos := Pos('(', sId);
    if nPos > 0 then
    begin
      sCnt := Copy(sId, nPos, Length(sId) - nPos + 1);
      Delete(sId, nPos, Length(sId) - nPos + 1);
    end else
      sCnt := '';

    SumString(Result, GetRuleNameFromId(sId) + sCnt, ',');
  end;
end;

function TManagerRule.GetRuleSearchStrFromIds(sIds: String): String;
var
  IdList: TStringList;
  i: Integer;
  pEnt: PRuleEnt;
begin
  Result := '';
  try
    Guard(IdList, TStringList.Create);
    SplitString(sIds, ';', IdList);
    for i := 0 to IdList.Count - 1 do
    begin
      pEnt := GetRuleFromId(IdList[i]);
      if pEnt = nil then
      begin
        _Trace('Not found rule .. ID=%s', [IdList[i]]);
        continue;
      end;

      SumString(Result, pEnt.sId + '::' + pEnt.sRVal + '::' +
          IntToStr(pEnt.nCnt) + '::' + IntToStr(Integer(pEnt.RType)) + '::' +
          BooleanToStr(pEnt.bAnd, 'T', 'F') +'::' + IntToStr(Integer(pEnt.RSeverity)), '**');

//      SumString(Result, pEnt.sId + '::' + pEnt.sRVal + '|*|' + IntToStr(pEnt.nCnt), '**');
    end;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. GetRuleSearchStrFromIds()');
  end;
end;

// 룰 코드가 아닌 이름으로 표시
function TManagerRule.GetRuleSearchStrFromIdsN(sIds: String): String;
var
  IdList: TStringList;
  i: Integer;
  pEnt: PRuleEnt;
begin
  Result := '';
  try
    Guard(IdList, TStringList.Create);
    SplitString(sIds, ';', IdList);
    for i := 0 to IdList.Count - 1 do
    begin
      pEnt := GetRuleFromId(IdList[i]);
      if pEnt = nil then
      begin
        _Trace('Not found rule .. ID=%s', [IdList[i]]);
        exit;
      end;

      SumString(Result, pEnt.sRName + '::' + pEnt.sRVal + '::' +
          IntToStr(pEnt.nCnt) + '::' + IntToStr(Integer(pEnt.RType)) + '::' +
          BooleanToStr(pEnt.bAnd, 'T', 'F') +'::' + IntToStr(Integer(pEnt.RSeverity)), '**');

//      SumString(Result, pEnt.sRName + '::' + pEnt.sRVal + '|*|' + IntToStr(pEnt.nCnt), '**');
    end;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. GetRuleSearchStrFromIds()');
  end;
end;

procedure TManagerRule.DelRule(sId: String);
var
  i: Integer;
begin
  try
    for i := 0 to RList_.Count - 1 do
      if RList_[i].sId = sId then
      begin
        RList_.Delete(i);
        exit;
      end;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. DelRule()');
  end;
end;

procedure TManagerRule.RefineRuleList(aList: TStringList);
var
  i: Integer;
  bMod: Boolean;
begin
  try
    if aList.Count = 0 then
      exit;

    bMod := false;
    for i := RList_.Count - 1 downto 0 do
      if aList.IndexOf(RList_[i].sId) = -1 then
      begin
        _Trace('RefineRuleList() .. Delete Rule .. ID=%s', [RList_[i].sId]);
        RList_.Delete(i);
        bMod := true;
      end;

    if bMod then Save;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. RefineRuleList()');
  end;
end;

procedure TManagerRule.Save;
var
  O, OA: ISuperObject;
  i: Integer;
begin
  OA := TSuperObject.Create(stArray);
  for i := 0 to RList_.Count - 1 do
    OA.AsArray.Add(TTgJson.ValueToJsonObject<TRuleEnt>(RList_[i]^));

  O := SO;
  O.O['List'] := OA;
  SaveJsonObjToEncFile(O, GetRunExePathDir + DIR_CONF + DAT_RULE, PASS_STRENC);
end;

procedure TManagerRule.Load;
var
  sPath, sTemp: String;
  O: ISuperObject;
  i: Integer;
  pEnt: PRuleEnt;
begin
  RList_.Clear;

  sPath := GetRunExePathDir + DIR_CONF + DAT_RULE;
  if not FileExists(sPath) then
    exit;

  if not LoadJsonObjFromEncFile(O, sPath, PASS_STRENC) then
    exit;

  if (O.O['List'] = nil) or (O.O['List'].DataType <> stArray) then
    exit;

  sTemp := '';
  for i := 0 to O.A['List'].Length - 1 do
  begin
    New(pEnt);
    pEnt.sId := O.A['List'].O[i].S['sId'];
    pEnt.sRName := O.A['List'].O[i].S['sRName'];
    pEnt.sRVal := O.A['List'].O[i].S['sRVal'];
    pEnt.nCnt := O.A['List'].O[i].I['nCnt'];
    pEnt.bAnd := O.A['List'].O[i].B['bAnd'];
    pEnt.RType := TRuleType(O.A['List'].O[i].I['RType']);
    pEnt.RSeverity := TRuleSeverity(O.A['List'].O[i].I['RSeverity']);
//    pEnt^ := TTgJson.GetDataAsType<TRuleEnt>(O.A['List'].O[i]);
    if pEnt.nCnt <= 0 then
      pEnt.nCnt := 1;
    RList_.Add(pEnt);

    if pEnt.RType = rtBrBlst then
      SumString(sTemp, pEnt.sRVal, '|');
  end;
  gMgSvc.PrefModel.UrlBlkRuleList := sTemp;
end;

procedure TManagerRule.UpdateRuleEnts(aO: ISuperObject);
var
  sRes, sRId, sTemp: String;
  O: ISuperObject;
  i, nErr: Integer;
  pEnt: PRuleEnt;
begin
  try
    if aO = nil then
      exit;

    if aO.DataType <> stArray then
      exit;


    _Trace('Update Contents Rule ..', 2);

    for i := 0 to aO.AsArray.Length - 1 do
    begin
      sRId := aO.AsArray.O[i].S['ruleId'];
      nErr := 0;
      sRes := gMgSvc.HttpPost(gMgSvc.DestIPort + 'ruleRequest.do', sRId, '{}', @nErr);
      if nErr = 404 then
      begin
        DelRule(sRId);
        _Trace('Delete Rule .. ID=%s', [sRId], 3);
        continue;
      end;

      try
        O := SO(sRes);
        if O = nil then
        begin
          _Trace('UpdateRuleEnts() .. Invalid Response ... 2, ID=%s', [sRId]);
          exit;
        end;
      except
        _Trace('UpdateRuleEnts() .. Invalid Response ... 1, ID=%s', [sRId]);
        exit;
      end;

//      {$IFDEF DEBUG} SaveJsonObjToFile(O, 'c:\rs.json'); {$ENDIF}

      pEnt := GetRuleFromId(sRId);
      if pEnt = nil then
      begin
        New(pEnt);
        ZeroMemory(pEnt, SizeOf(TRuleEnt));
        pEnt.sId := sRId;
        RList_.Add(pEnt);

        _Trace('Add Rule .. ID=%s', [sRId], 3);
      end;

      with pEnt^ do
      begin
        sTemp := O.S['RULE_TYPE'].ToLower;
        if sTemp = 'browserblocklist' then
        begin
        // 브라우저 접속 차단 목록, 대량의 데이터 처리를 위해 여기에 추가 25_0414 15:15:56 kku
          RType := rtBrBlst;
          sRVal := O.S['RULE_VALUE'];

        // 파싱 속도 줄이기 위해 다른건 무시
          continue;
        end else
        if sTemp = 'pattern' then
          RType := rtPattern
        else if sTemp = 'exceptpattern' then
          RType := rtExceptPattern
        else if sTemp = 'exceptkeyword' then
          RType := rtExceptKeyword
        else
          RType := rtKeyword;

//        sId,
        sRName := O.S['RULE_NAME'];
        sRVal := O.S['RULE_VALUE'];
        nCnt := StrToIntDef(O.S['RULE_COUNT'], 1);
        if nCnt <= 0 then
          nCnt := 1;
        bAnd := O.S['RULE_ANDCHECK'].ToLower = 'true';
//        if bAnd then
//          bAnd := true;
        sTemp := O.S['RULE_SEVERITY'].ToLower;
        if sTemp = 'normal' then
          RSeverity := rsNormal
        else if sTemp = 'high' then
          RSeverity := rsHigh
        else
          RSeverity := rsLow;
      end;
    end;
    Save;

    sTemp := '';
    for i := 0 to RList_.Count - 1 do
      if RList_[i].RType = rtBrBlst then
        SumString(sTemp, RList_[i].sRVal, '|');
    gMgSvc.PrefModel.UrlBlkRuleList := sTemp;

    _Trace('Update Contents Rule .. OK', 2);
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ProcessRcvCampaign()');
  end;
end;

end.