BSOne.SFC/eCrmHE/EXE_eCrmHomeEdition/Manager/ManagerRule.pas

461 lines
12 KiB
Plaintext

{*******************************************************}
{ }
{ 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.