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 covered45
Number of lines with code gen50
Line coverage90%


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.