Delphi CodeCoverage Coverage Report

Coverage report for Casbin.Matcher.

Generated at 18/02/2019 12:10:19 by DelphiCodeCoverage - an open source tool for Delphi Code Coverage.

Statistics for Casbin.Matcher.pas

Number of lines covered	45
Number of lines with code gen	50
Line coverage	90%

// Copyright 2018 by John Kouraklis and Contributors. All Rights Reserved.
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//      http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
unit Casbin.Matcher;

interface

uses
  Casbin.Core.Base.Types, Casbin.Matcher.Types, Casbin.Effect.Types, ParseExpr, System.Generics.Collections;

type
  TMatcher = class (TBaseInterfacedObject, IMatcher)
  private
    fMatcherString: string;
    fMathsParser: TCStyleParser;
    fIdentifiers: TDictionary<string, integer>;
    procedure cleanMatcher;
    procedure replaceIdentifiers(var aParseString: string);
  private
  {$REGION 'Interface'}
    function evaluateMatcher(const aMatcherString: string): TEffectResult;
    procedure clearIdentifiers;
    procedure addIdentifier (const aTag: string);
  {$ENDREGION}
  public
    constructor Create;
    destructor Destroy; override;

  end;

implementation

uses
  System.StrUtils, System.SysUtils, Casbin.Exception.Types, System.Rtti, Casbin.Core.Defaults;

procedure TMatcher.clearIdentifiers;
begin
  fIdentifiers.Clear;
end;

constructor TMatcher.Create;
var
  item: string;
begin
  inherited;
  fMathsParser:=TCStyleParser.Create;
  TCStyleParser(fMathsParser).CStyle:=False;
  fIdentifiers:=TDictionary<string, integer>.Create;
  addIdentifier('true');
  addIdentifier('false');

  for item in builtinAccounts do
    addIdentifier(item);
end;

destructor TMatcher.Destroy;
begin
  fIdentifiers.Free;
  fMathsParser.Free;
  inherited;
end;

{ TMatcher }

procedure TMatcher.addIdentifier(const aTag: string);
var
  tag: string;
begin
  tag:=UpperCase(Trim(aTag));
  if not fIdentifiers.ContainsKey(tag) then
    fIdentifiers.Add(tag, Integer(Round(Random*100)));
end;

procedure TMatcher.cleanMatcher;
var
  index: Integer;
begin
  fMatcherString:=ReplaceStr(fMatcherString, '==', '=');
  fMatcherString:=ReplaceStr(fMatcherString, '&&', 'and');
  fMatcherString:=ReplaceStr(fMatcherString, '||', 'or');
  fMatcherString:=ReplaceStr(fMatcherString, '!', 'not');
  index:=Pos('''', fMatcherString, Low(string));
  while Index<>0 do
  begin
    Delete(fMatcherString, index, 1);
    index:=Pos('''', fMatcherString, Low(string));
  end;
end;

function TMatcher.evaluateMatcher(const aMatcherString: string): TEffectResult;
var
  eval: string;
begin
  fMatcherString:=UpperCase(aMatcherString);
  if Trim(fMatcherString)='' then
  begin
    Result:=erIndeterminate;
    Exit;
  end;
  cleanMatcher;
  replaceIdentifiers(fMatcherString);

  {TODO -oOwner -cGeneral : ReplaceStr(functions in expressions)}
  fMathsParser.Optimize := true;
  eval:=fMathsParser.AsString[fMathsParser.AddExpression(trim(fMatcherString))];
  if upperCase(eval)='TRUE' then
    Result:=erAllow
  else
    result:=erDeny;
end;

procedure TMatcher.replaceIdentifiers(var aParseString: string);
var
  pair: TPair<string, integer>;
begin
  for pair in fIdentifiers do
    aParseString:=aParseString.Replace(pair.Key, pair.Value.ToString, [rfReplaceAll]);
end;

end.

1	// Copyright 2018 by John Kouraklis and Contributors. All Rights Reserved.
2	//
3	// Licensed under the Apache License, Version 2.0 (the "License");
4	// you may not use this file except in compliance with the License.
5	// You may obtain a copy of the License at
6	//
7	// http://www.apache.org/licenses/LICENSE-2.0
8	//
9	// Unless required by applicable law or agreed to in writing, software
10	// distributed under the License is distributed on an "AS IS" BASIS,
11	// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12	// See the License for the specific language governing permissions and
13	// limitations under the License.
14	unit Casbin.Matcher;
15
16	interface
17
18	uses
19	Casbin.Core.Base.Types, Casbin.Matcher.Types, Casbin.Effect.Types, ParseExpr, System.Generics.Collections;
20
21	type
22	TMatcher = class (TBaseInterfacedObject, IMatcher)
23	private
24	fMatcherString: string;
25	fMathsParser: TCStyleParser;
26	fIdentifiers: TDictionary<string, integer>;
27	procedure cleanMatcher;
28	procedure replaceIdentifiers(var aParseString: string);
29	private
30	{$REGION 'Interface'}
31	function evaluateMatcher(const aMatcherString: string): TEffectResult;
32	procedure clearIdentifiers;
33	procedure addIdentifier (const aTag: string);
34	{$ENDREGION}
35	public
36	constructor Create;
37	destructor Destroy; override;
38
39	end;
40
41	implementation
42
43	uses
44	System.StrUtils, System.SysUtils, Casbin.Exception.Types, System.Rtti, Casbin.Core.Defaults;
45
46	procedure TMatcher.clearIdentifiers;
47	begin
48	fIdentifiers.Clear;
49	end;
50
51	constructor TMatcher.Create;
52	var
53	item: string;
54	begin
55	inherited;
56	fMathsParser:=TCStyleParser.Create;
57	TCStyleParser(fMathsParser).CStyle:=False;
58	fIdentifiers:=TDictionary<string, integer>.Create;
59	addIdentifier('true');
60	addIdentifier('false');
61
62	for item in builtinAccounts do
63	addIdentifier(item);
64	end;
65
66	destructor TMatcher.Destroy;
67	begin
68	fIdentifiers.Free;
69	fMathsParser.Free;
70	inherited;
71	end;
72
73	{ TMatcher }
74
75	procedure TMatcher.addIdentifier(const aTag: string);
76	var
77	tag: string;
78	begin
79	tag:=UpperCase(Trim(aTag));
80	if not fIdentifiers.ContainsKey(tag) then
81	fIdentifiers.Add(tag, Integer(Round(Random*100)));
82	end;
83
84	procedure TMatcher.cleanMatcher;
85	var
86	index: Integer;
87	begin
88	fMatcherString:=ReplaceStr(fMatcherString, '==', '=');
89	fMatcherString:=ReplaceStr(fMatcherString, '&&', 'and');
90	fMatcherString:=ReplaceStr(fMatcherString, '\|\|', 'or');
91	fMatcherString:=ReplaceStr(fMatcherString, '!', 'not');
92	index:=Pos('''', fMatcherString, Low(string));
93	while Index<>0 do
94	begin
95	Delete(fMatcherString, index, 1);
96	index:=Pos('''', fMatcherString, Low(string));
97	end;
98	end;
99
100	function TMatcher.evaluateMatcher(const aMatcherString: string): TEffectResult;
101	var
102	eval: string;
103	begin
104	fMatcherString:=UpperCase(aMatcherString);
105	if Trim(fMatcherString)='' then
106	begin
107	Result:=erIndeterminate;
108	Exit;
109	end;
110	cleanMatcher;
111	replaceIdentifiers(fMatcherString);
112
113	{TODO -oOwner -cGeneral : ReplaceStr(functions in expressions)}
114	fMathsParser.Optimize := true;
115	eval:=fMathsParser.AsString[fMathsParser.AddExpression(trim(fMatcherString))];
116	if upperCase(eval)='TRUE' then
117	Result:=erAllow
118	else
119	result:=erDeny;
120	end;
121
122	procedure TMatcher.replaceIdentifiers(var aParseString: string);
123	var
124	pair: TPair<string, integer>;
125	begin
126	for pair in fIdentifiers do
127	aParseString:=aParseString.Replace(pair.Key, pair.Value.ToString, [rfReplaceAll]);
128	end;
129
130	end.