Coverage report for Casbin.Model.

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

Statistics for Casbin.Model.pas

Number of lines covered141
Number of lines with code gen148
Line coverage95%


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.Model;
15
16
interface
17
18
uses
19
  Casbin.Core.Base.Types, Casbin.Model.Types, Casbin.Adapter.Types,
20
  Casbin.Parser.Types, Casbin.Parser.AST.Types, Casbin.Model.Sections.Types,
21
  System.Generics.Collections, Casbin.Effect.Types, Casbin.Watcher.Types;
22
23
type
24
  TModel = class (TBaseInterfacedObject, IModel)
25
  private
26
    fAdapter: IAdapter;  //PALOFF
27
    fParser: IParser;    //PALOFF
28
    fNodes: TNodeCollection;
29
    fAssertions: TList<string>;
30
    fWatchers: TList<IWatcher>;
31
32
    procedure checkSection(const aSection: TSectionType);
33
    procedure loadNodes(const aAdapter: IAdapter);
34
  protected
35
{$REGION 'Interface'}
36
    function section(const aSection: TSectionType; const aSlim: Boolean = true):
37
        string;
38
    function assertions(const aSection: TSectionType): TList<System.string>;
39
    function effectCondition: TEffectCondition;
40
    procedure addDefinition (const aSection: TSectionType; const aTag: string;
41
                              const aAssertion: string); overload;
42
    procedure addDefinition (const aSection: TSectionType;
43
                              const aAssertion: string); overload;
44
    procedure addModel(const aModel: string);
45
    function assertionExists (const aAssertion: string): Boolean;
46
    function toOutputString: string;
47
48
    // Watchers
49
    procedure registerWatcher (const aWatcher: IWatcher);
50
    procedure unregisterWatcher (const aWatcher: IWatcher);
51
    procedure notifyWatchers;
52
{$ENDREGION}
53
  public
54
    constructor Create(const aModelFilename: string); overload;
55
    constructor Create(const aAdapter: IAdapter); overload;
56
    constructor Create; overload;
57
    destructor Destroy; override;
58
  end;
59
60
implementation
61
62
uses
63
  Casbin.Exception.Types, Casbin.Adapter.Filesystem,
64
  System.IOUtils, System.Classes, Casbin.Parser, Casbin.Core.Utilities,
65
  SysUtils, Casbin.Parser.AST, Casbin.Model.Sections.Default, Casbin.Adapter.Memory;
66
67
constructor TModel.Create(const aModelFilename: string);
68
begin
69
  Create(TFileAdapter.Create(aModelFilename));
70
end;
71
72
procedure TModel.addDefinition(const aSection: TSectionType;
73
  const aAssertion: string);
74
var
75
  arrStr: TArray<string>;
76
begin
77
  if trim(aAssertion)='' then
78
    raise ECasbinException.Create('The Assertion is empty');
79
  arrStr:=aAssertion.Split(['=']);
80
  if Length(arrStr)<>2 then
81
    raise ECasbinException.Create('The Assertion '+aAssertion+' is wrong');
82
  addDefinition(aSection, arrStr[0], arrStr[1]);
83
end;
84
85
procedure TModel.addModel(const aModel: string);
86
begin
87
  if Trim(aModel)='' then
88
    Exit;
89
  fAdapter.Assertions.Clear;
90
  fAdapter.Assertions.AddRange(aModel.Split([sLineBreak]));
91
  loadNodes(fAdapter);
92
  fAssertions.Clear;
93
end;
94
95
procedure TModel.addDefinition(const aSection: TSectionType; const aTag,
96
  aAssertion: string);
97
var
98
  header: THeaderNode;
99
  assertion: string;
100
  foundHeader: Boolean;
101
  sec: TSection;
102
begin
103
  foundHeader:=False;
104
  if trim(aTag)='' then
105
    raise ECasbinException.Create('The Tag is empty');
106
  if trim(aAssertion)='' then
107
    raise ECasbinException.Create('The Assertion is empty');
108
  if (aSection=stDefault) or (aSection=stUnknown) or
109
      (aSection=stPolicyRules) or (aSection=stRoleRules) then
110
    raise ECasbinException.Create('Wrong section type');
111
112
  assertion:= Trim(aTag)+'='+trim(aAssertion);
113
114
  if not (aSection=stMatchers) then
115
    while Pos(#32, assertion, findStartPos)<>0 do
116
      Delete(assertion, Pos(#32, assertion, findStartPos), 1);
117
118
  if assertionExists(assertion) then
119
    Exit
120
  else
121
  begin
122
    for header in fNodes.Headers do
123
      if header.SectionType=aSection then
124
      begin
125
        addAssertion(header, assertion);
126
        foundHeader:=True;
127
        Break;
128
      end;
129
    if not foundHeader then
130
    begin
131
      sec:=createDefaultSection(aSection);
132
      header:=THeaderNode.Create;
133
      header.Value:=sec.Header;
134
      header.SectionType:=aSection;
135
      fNodes.Headers.Add(header);
136
137
      addAssertion(header, assertion);
138
      sec.Free;
139
    end;
140
    notifyWatchers;
141
  end;
142
end;
143
144
function TModel.assertionExists(const aAssertion: string): Boolean;
145
var
146
  child: TChildNode;
147
  header: THeaderNode;
148
begin
149
  Result:=false;
150
  if Trim(aAssertion)='' then
151
    Exit;
152
153
  for header in fNodes.Headers do
154
  begin
155
    for child in header.ChildNodes do
156
    begin
157
      Result:= Trim(child.toOutputString) = Trim(aAssertion);
158
159
      if Result then
160
        Exit;
161
    end;
162
  end;
163
end;
164
165
function TModel.assertions(const aSection: TSectionType): TList<System.string>;
166
var
167
  node: TChildNode;
168
  headerNode: THeaderNode;
169
  assertionNode: TAssertionNode;
170
  assertion: string;
171
begin
172
  fAssertions.Clear;
173
  checkSection(aSection);
174
  for headerNode in fNodes.Headers do
175
    if headerNode.SectionType=aSection then
176
    begin
177
      for node in headerNode.ChildNodes do
178
      begin
179
        if node.AssertionList.Count=0 then
180
          fAssertions.add(node.Value)
181
        else
182
        begin
183
          for assertionNode in node.AssertionList do
184
          begin
185
            assertion:=node.Key+'.'+assertionNode.Value;
186
            fAssertions.Add(assertion);
187
          end;
188
        end;
189
      end;
190
      Break;
191
    end;
192
  Result:=fAssertions;
193
end;
194
195
constructor TModel.Create(const aAdapter: IAdapter);
196
begin
197
  if not Assigned(aAdapter) then
198
    raise ECasbinException.Create('Adapter is nil in '+Self.ClassName);
199
  inherited Create;
200
  loadNodes(aAdapter);
201
  fAssertions:=TList<string>.Create;
202
  fWatchers:=TList<IWatcher>.Create;
203
end;
204
205
constructor TModel.Create;
206
begin
207
  Create(TMemoryAdapter.Create);
208
end;
209
210
destructor TModel.Destroy;
211
begin
212
  fAssertions.Free;
213
  fWatchers.Free;
214
  inherited;
215
end;
216
217
function TModel.effectCondition: TEffectCondition;
218
var
219
  headerNode: THeaderNode;
220
begin
221
  Result:=ecUnknown;
222
  for headerNode in fParser.Nodes.Headers do
223
  begin
224
    if headerNode.SectionType=stPolicyEffect then
225
    begin
226
      if (headerNode.ChildNodes.Count>=0) and
227
        (headerNode.ChildNodes.Items[0] is TEffectNode) then
228
      begin
229
        Result:=(headerNode.ChildNodes.Items[0] as TEffectNode).EffectCondition;
230
      end;
231
    end;
232
  end;
233
end;
234
235
procedure TModel.checkSection(const aSection: TSectionType);
236
begin
237
  if not (aSection in [stRequestDefinition, stPolicyDefinition,
238
                       stPolicyEffect, stMatchers,
239
                       stRoleDefinition]) then
240
    raise ECasbinException.Create('Wrong section type');
241
end;
242
243
procedure TModel.loadNodes(const aAdapter: IAdapter);
244
begin
245
  fAdapter:=aAdapter;
246
  fAdapter.load;
247
  fParser:=TParser.Create(fAdapter.toOutputString, ptModel);
248
  fParser.parse;
249
  if fParser.Status=psError then
250
    raise ECasbinException.Create('Parsing error in Model: '+fParser.ErrorMessage);
251
  fNodes:=fParser.Nodes;
252
end;
253
254
procedure TModel.notifyWatchers;
255
var
256
  watcher: IWatcher;
257
begin
258
  for watcher in fWatchers do
259
    watcher.update;
260
end;
261
262
procedure TModel.registerWatcher(const aWatcher: IWatcher);
263
begin
264
  if not fWatchers.Contains(aWatcher) then
265
    fWatchers.Add(aWatcher);
266
end;
267
268
function TModel.section(const aSection: TSectionType; const aSlim: Boolean =
269
    true): string;
270
var
271
  headerNode: THeaderNode;
272
  strList: TStringList;
273
begin
274
  Result:='';
275
  if fNodes.Headers.Count=0 then
276
    Exit;
277
  checkSection(aSection);
278
  for headerNode in fNodes.Headers do
279
    if headerNode.SectionType=aSection then
280
    begin
281
      Result:=headerNode.toOutputString;
282
      strList:=TStringList.Create;
283
      strList.Text:=Result;
284
      if (strList.Count>1) then
285
        if aSlim and (strList.Strings[0][findStartPos]='[') then
286
          Result:=strList.Strings[1];
287
      strList.Free;
288
      Exit;
289
    end;
290
end;
291
292
function TModel.toOutputString: string;
293
var
294
  secType: TSectionType;
295
begin
296
  result:='';
297
  for secType in modelSections do
298
  begin
299
    if (secType=stRoleDefinition) then
300
    begin
301
        if (section(stRoleDefinition, False))<>'' then
302
        begin
303
          Result:=Result+section(secType, false)+sLineBreak;
304
        end;
305
    end
306
    else
307
      Result:=Result+section(secType, false)+sLineBreak;
308
  end;
309
end;
310
311
procedure TModel.unregisterWatcher(const aWatcher: IWatcher);
312
begin
313
  if fWatchers.Contains(aWatcher) then
314
    fWatchers.Remove(aWatcher);
315
end;
316
317
end.